Numerik olmayan değerleri silmek

[Yüksel Varlı]

Merhaba,
"A1:F25 aralığındaki hücrelerde numerik olmayan tüm değerleri sil." şeklinde bir makro yazabilir miyiz? Silinecek değerlerin içerisine + , - , * ,/, gibi işaretler de var.
Selamlar

 

[Merhum İdris SERDAR]

.

Aşağıdaki kodları deneyin.

Kodlar yabancı bir siteden alınmadır.

Sub KillNonNumbers()
    Dim rng1 As Range
    Dim rngArea As Range
    Dim lngRow As Long
    Dim lngCol As Long
    Dim lngCalc As Long
    Dim objReg As Object
    Dim X()


    On Error Resume Next
    Set rng1 = Range("a1:f25")
    If rng1 Is Nothing Then Exit Sub
    rng1.Select
    On Error GoTo 0

    
    Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "[^\d]+"
    objReg.Global = True

  
    With Application
        lngCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

   
    For Each rngArea In rng1.Areas
        
        If rngArea.Cells.Count > 1 Then
           
            X = rngArea.Value2
            For lngRow = 1 To rngArea.Rows.Count
                For lngCol = 1 To rngArea.Columns.Count
                    
                    X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), vbNullString)
                Next lngCol
            Next lngRow
            
            rngArea.Value2 = X
        Else
            
            rngArea.Value = objReg.Replace(rngArea.Value, vbNullString)
        End If
    Next rngArea

    
    With Application
        .ScreenUpdating = True
        .Calculation = lngCalc
        .EnableEvents = True
    End With

    Set objReg = Nothing
     Range("G6").Select
End Sub

 

[Yüksel Varlı]

Sn Yurttaş,
çok teşekkür ediyorum. Sağolun