• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

Katılım
8 Eylül 2008
Mesajlar
950
Excel Vers. ve Dili
2016 İngilizce
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
 
. . .

Kod:
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

. . .
 
Ç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
 
. . .

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

. . .
 
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
 
. . .

14556288581.png


Kod:
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

. . .
 
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
 
. . .

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.

. . .
 
. . .

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

. . .
 
Ü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.

Kod:
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
 
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.
 
. . .

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.

Kod:
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

. . .
 
Ü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
 
Geri
Üst