Hücre içindeki veriden rakam olan veriyi bir yandaki hücreye yazdırma

[u.L.a.s]

merhabalar

Diyelimki aşağıdaki gibi alt alta satırlarda verilerim var.

A1 de aaaaa 1500 rrrmnnmmnlll
A2 de 2500 ddd lll ppp iiiiiiiiii
A3 de ddddd dddd ddeee 3300

Bu tür harf ve rakamlardan oluşmuş verilerin içerisinden rakamlar herhangi bir yerde olablliyor.
bir yan satırına rakamları getirmek istiyorum. yardımlarınızı rica ederim

Sonuç aşağıdaki gibi olacak
B1 de 1500
B2 de 2500
B3 te 3300

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        metin = Cells(i, "A")
        f = WorksheetFunction.Substitute(metin, " ", "")
        say = Len(metin) - Len(f)
        For s = 0 To say
            a = Split(metin, (" "))(s)
            If IsNumeric(a) Then
                Cells(i, "B") = a
                Exit For
            End If
        Next s
    Next i
End Sub

. . .

 

[u.L.a.s]

Çok teşekkür ederim çok ufak bir sıkıntı var.

örneğin A1 deki veri aşağıdaki gibiyse yani rakamın hemen yanında - işareti varsa yan hücreye aktarmıyor. bu sorun nasıl aşılabilir acaba bilgi ve yardımlarınızı rica ederim

A1 de aaaaa -1500 rrrmnnmmnlll

 

[Emir Hüseyin Çoban]

. . .

-1500 olarak mı aktarması gerekiyor. Sadece 1500 olarak mı.

. . .

 

[u.L.a.s]

Sadece 1500 olarak aktaracak

Eğer tire işareti aşağıdaki gibi sol taraftaysa rakamı aktarmıyor. boş geliyor
aaaaa -1500 rrrmnnmmnlll

Eğer Tire işareti rakamın sağındaysa aşağıdaki gibi. 1500- şeklinde aktarıyor. yani yanındaki bitişik karakteride alıyor.

ben ise solunda varsa - veya başka karakter. görmesin onu direk 1500 i alsın istiyorum. yada sağda tire veya başkla karakter varsa o karakterle beraber almasın. rakam gelsin istiyorum
aaaaa 1500- rrrmnnmmnlll

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        metin = Cells(i, "A")
        f = WorksheetFunction.Substitute(metin, " ", "")
        say = Len(metin) - Len(f)
        For s = 0 To say
            a = Split(metin, (" "))(s)
            If IsNumeric(a) Then
                Cells(i, "B") = [B][COLOR="DarkRed"]Abs(a)[/COLOR][/B]
                Exit For
            End If
        Next s
    Next i
End Sub

. . .

 

[u.L.a.s]

Verdiğiniz kodları uyguladım sonuç aynı.

Örneğin benim hücredeki verim aynen aşağıdaki gibi. ben bu veri içinden 5776 yı almak istiyorum. ama boş aktarıyor. eğer yanında tire işareti yoksa sayıyı aktarabiliyor.

ESKISEHIR OSB TEPE HOME-5776 ATM DEPOYA ALIM

 

[Emir Hüseyin Çoban]

. . .

Kodlar boşluk mantığına göre çalışır.
"HOME boşluk -5776" ise aktarır. HOME-5776 verisinde boşluk olmadığı için aktaramaz.

. . .

 

[Emir Hüseyin Çoban]

. . .

Verilerinizde sayısal değerler ikikez geçebilir mi.
Örneğin aaaa bbbb 1500 ccc 2500 ddd olabilir mi.

. . .

 

[u.L.a.s]

Üstadım engin bilgilerin için çok teşekkürler.

o halde bütün sütunu seçip replace yaparak search kısmına - yazıp replace kısmına - (boşluk) yazıp rakamla tire işaretini ayırıp replace all yapma işini makroya gömersek aşağıdaki gibi bir kod olur.

Sub KOD()
    Columns("A:A").Select
    Selection.Replace What:="-", Replacement:="- ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        metin = Cells(i, "A")
        f = WorksheetFunction.Substitute(metin, " ", "")
        say = Len(metin) - Len(f)
        For s = 0 To say
            a = Split(metin, (" "))(s)
            If IsNumeric(a) Then
                Cells(i, "B") = Abs(a)
                Exit For
            End If
        Next s
    Next i

End Sub

 

[u.L.a.s]

Evet aslında bir veri içerisinde aşağıdaki 2 ayrı sayısal değerde var. 2821 ve 2827 gibi ama tabi bu veride 1 ve 2 gibi ayrı bir rakamlarda var. dolayısıyla bu kodla ilk gördüğü rakamı alıyor. diğerleri kalıyor.

GAZIANTEP ISTASYON CADDESI 1 ve GAZIANTEP ISTASYON CADDESI 2 - 2821 ve 2827- BTM`lerin depoya alım HK.

 

[Emir Hüseyin Çoban]

. . .

Verilerinizde belirli bir koşul şartı olmadığı için tertemiz ayırmasını beklemeyin.
Verilerde bulduğu sayısal değerleri B-C-D >> diyerek sütunlara ayırır.

Sub KOD()
    Columns("A:A").Select
    Selection.Replace What:="-", Replacement:="- ", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        süt = 2
        metin = Cells(i, "A")
        f = WorksheetFunction.Substitute(metin, " ", "")
        say = Len(metin) - Len(f)
        For s = 0 To say
            a = Split(metin, (" "))(s)
            If IsNumeric(a) Then
                Cells(i, süt) = Abs(a)
                süt = süt + 1
                'Exit For
            End If
        Next s
    Next i
End Sub

. . .

 

[u.L.a.s]

Üstadım emeğine bilgine sağlık dediğiniz gibi zaten temiz bir ayırma yapmak çok zor. ama bu kodla temize yakın bir ayırma olmuş oldu. çok çok teşekkür ederim