Metnin içinde yer alan iki karakterin arasındaki değeri alma

[curpug]

Arkadaşlar merhaba,

PARÇAAL, YERİNEKOY gibi komutlarla yaklaşık 2 saat denedim fakat beceremedim. Sorum şu;

Aşağıdakine benzer satırlarım var:

0216 252 11 00 | Ad Soyad - email@mynet.com - 01.04.2021 | 60,19 EUR | Kalan: 23,57 EUR - Tahsil Edildi
0216 111 11 00 | Ad Soyad (firması)- emai2l@mynet2.com - 01.05.2021 | 10 EUR | Kalan: 2 EUR - Tahsil Edildi
0216 111 11 00 | Ad Soyad (Yedek ad soyad) - emai2l@mynet2.com - 01.10.2021 | 156,50 EUR | Kalan: 85,57 EUR - Tahsil Edilmedi

Bu satırlardan 100lerce var. Bu satırlarda yer alan EUR değerinin hemen yanındaki rakamı alıp başka bir sütuna atmak istiyorum. Farkettiyseniz iki tane EUR değer mevcut. Birinci EUR değeri başka sütuna, ikinci EUR alanını başka sütuna yazdırmak istiyorum. Elimdeki tek parametreyse göreceğiniz üzere dikey çizgi " | " karakterinin aralarında yer alıyor rakamlar. Rakamlar değişkenlik gösterdiği için "SAĞDAN-SOLDAN" fonksiyonları kullanamadım.

Veri > Metni Sütunlara Dönüştür kısmından denedim ancak işin içine (Yedek ad soyad) girince metni sütunlara dönüştüremiyorum.

Nasıl bir yol izlemeliyim sizce?

 

[Haluk]

" | " karakterini kullanarak metni sütunlara dönüştür ile ilk hamleden sonra, bu kez D sütununda "boşluk" karakterini kullanarak yine metni sütunlara dönüştür seçeneği ile yapılabiliyor.....

.

 

[curpug]

" | " karakterini kullanarak metni sütunlara dönüştür ile ilk hamleden sonra, bu kez D sütununda "boşluk" karakterini kullanarak yine metni sütunlara dönüştür seçeneği ile yapılabiliyor.....

.

Haluk Bey cevabınız için teşekkürler. Bunu düzenli olarak yapmam biraz uzun sürecek. Liste aslında çok uzun. Bir formülize etmemim yolu var mı acaba? Metni sütunlara Dönüştür özelliği gibi parçalayabilecek bir formül arayışındayım

 

[Muzaffer Ali]

Merhaba.

Metinlerin A sütununda olduğunu var sayarsak birincisini B ikincisini C sütununa yazacak şekilde kodlar aşağıdadır.

Sub Test()
    Dim i As Variant
    Dim Bak As Integer
    For Bak = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        i = Split(Cells(Bak, "A"), "|")
        Cells(Bak, "B") = CDbl(Replace(Replace(i(2), "EUR", ""), " ", ""))
        i = Split(i(3), "-")
        Cells(Bak, "C") = CDbl(Replace(Replace(Replace(i(0), "EUR", ""), "Kalan:", ""), " ", ""))
    Next
End Sub

 

[Haluk]

Alternatif olarak, RegExp metodonunun kullanıldığı KullanıcıTanımlıFonksiyon içeren ekli dosyayı inceleyebilirsiniz....

Test.xlsm dosyasını indir - download

Test.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

.

 

[muratboz06]

Hızlı Doldurma ile yapabilirsiniz.
Verileriniz A sütununda olduğu varsayımı ile;
B1 hücresine 60,19 yazın, Veri>Hızlı Doldurma tıklayın.
C1 hücresine 23,57 yazın, Veri>Hızlı Doldurma tıklayın.

 

[veyselemre]

Sub test()
    With CreateObject("Vbscript.Regexp")
        .Pattern = "([\d,]+ EUR)"
        .Global = True
        For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
            If .test(Cells(i, 1).Value) Then
                sut = 2
                For Each mtch In .Execute(Cells(i, 1).Value)
                    mtch = Replace(Replace(mtch, "EUR", ""), ",", ".")
                    Cells(i, sut).Value = CDbl(mtch)
                    sut = sut + 1
                Next
            End If
        Next i
    End With
End Sub

 

[curpug]

@Haluk @Muzaffer Ali @muratboz06 @veyselemre

Sevgili arkadaşlar ne kadar teşekkür etsem sizlere az. Sorunumu hem harika yollarla çözmüş oldum, hem de her birinizin farklı bakış açısı, farklı sayısal yorumlarıyla kendimi geliştirme fırsatı buldum. Gerçekten içtenlikle teşekkür ederim.