hücre içinde rakam ve harf ayrımı

[desinger07]

Merhaba benim sorumum hücre içirisinde olan rakam ve harfleri ayırarak rakamları içerisinden çekmek

Bununla ilgili kodları vermişsiniz ama kodlar çalışıyor ama içierisinde virgüllü olarak almıyor. virgüllü olarak almak mümkün mü örnek bir dosya ektedir.

Yardımcı olabilirseniz sevinirim
Teşekkürler


Sub sayısec()
Dim i As Integer
For Each hucre In Selection
For i = 1 To Len(hucre)
Sayi = Mid(hucre, i, 1)
If IsNumeric(Sayi) = True Then
ActiveCell.Offset(0, 1) = ActiveCell.Offset(0, 1) & Sayi
End If
Next
Next
End Sub

 

[Orion1]

Dosyanız ekte.

Sub sayısec()
Dim i As Integer, a As Integer
ReDim dizi(1 To 1, 1 To 1)
On Error Resume Next
For Each hucre In Selection
For i = 1 To Len(hucre)
sayi = Mid(hucre, i, 1)
If IsNumeric(sayi) = False And sayi <> "," Then
a = a + 1
ReDim Preserve dizi(1 To 1, 1 To a)
dizi(1, a) = sayi
End If
Next
If a > 0 Then
deg = hucre
For k = LBound(dizi, 2) To UBound(dizi, 2)
    deg = Replace(deg, dizi(1, k), "")
Next k
End If
ActiveCell.Offset(0, 1).Value = CDbl(deg)
Next
End Sub

 

[Levent Menteşoğlu]

Alternatif olarak aşağıdaki koduda deneyebilirsiniz.

Sub sayilarial()
Set deg = CreateObject("VBScript.Regexp")
deg.Pattern = "[^0-9,]"
deg.Global = True
For a = 2 To [b65536].End(3).Row
Cells(a, "f") = CDbl(deg.Replace(Cells(a, "b"), ""))
Cells(a, "g") = CDbl(deg.Replace(Cells(a, "e"), ""))
Next
Set deg = Nothing
End Sub

 

[Orion1]

Alternatif olarak aşağıdaki koduda deneyebilirsiniz.

Sub sayilarial()
Set deg = CreateObject("VBScript.Regexp")
deg.Pattern = "[^0-9,]"
deg.Global = True
For a = 2 To [b65536].End(3).Row
Cells(a, "f") = CDbl(deg.Replace(Cells(a, "b"), ""))
Cells(a, "g") = CDbl(deg.Replace(Cells(a, "e"), ""))
Next
Set deg = Nothing
End Sub

Levent bey,
Bu güzel kodlar için teşekkür ederim.
Bende hemen arşivime attım.
İyi günler.

 

[desinger07]

Teşekkürler çok işimi hızlandırdı.