Verinin en son 2 değerini parçala ve yaz.

[ahzola]

Selamlar

A sütununa girdiğim verinin en son 2 değerini
B ve C sütununa yazacak bir makro istemekteyim.
(virgül, apostrof, boşluk vs bunlar ayıklanacak/yazılmayacak)

yardımlarınızı bekliyorum
saygılarımla.

 

[Levent Menteşoğlu]

Bir örnek dosya eklermisiniz. Bu dosyada mevcut veri ve yazılmasını istediğiniz şekli mutlaka belirtiniz. Özellikle ayıklanacak veri içeren örneklerde olsun.

 

[ahzola]

Merhaba Levent Bey

iyi akşamlar diliyorum.

yazım örnekleri için dosyamız ekte

 

[Levent Menteşoğlu]

Aşağıdaki kodu denermisiniz.

Sub soniki()
Set deg = CreateObject("VBScript.Regexp")
deg.Pattern = "[^0-9,aA-zZ\çÇ\ğĞ\ıİ\öÖ\şŞ\üÜ]"
deg.Global = True
For a = 1 To [a65536].End(3).Row
veri = Right(deg.Replace(Cells(a, "a"), ""), 2)
Cells(a, "e") = Left(veri, 1)
Cells(a, "f") = Right(veri, 1)
Next
End Sub

 

[ahzola]

Merhaba
Levent Bey

alakanız için çok teşekkür ederim.
makromuzda düzeltilmesi gereken bir nüans var.

son 2 değer şayet aynı olursa sadece 1 tanesi yazıyor

örneğin
18+ dediğimizde 18 yazıyor
88+ dediğimizde sadece 8 yazıyor.

 

[Levent Menteşoğlu]

Yukarıda verdiğim kodu değiştirdim. Tekrar deneyebilirsiniz.

 

[ahzola]

Çok Teşekkür ediyorum.

Sn Levent Bey

herşeyin gönlünüzce olması dileğiyle.
iyi akşamlar.

 

[Levent Menteşoğlu]

Çok Teşekkür ediyorum.

Sn Levent Bey

herşeyin gönlünüzce olması dileğiyle.
iyi akşamlar.

Rica ederim. Sizede iyi akşamlar.

 

[hakantb]

Yukarıda verdiğim kodu değiştirdim. Tekrar deneyebilirsiniz.

Sayın Menteşoğlu özür dilerim benmi göremiyorum yoksa silinmişmi

 

[ahzola]

Sub son()
Set deg = CreateObject("VBScript.Regexp")
deg.Pattern = "[^0-9,aA-zZ\çÇ\ğĞ\ıİ\öÖ\şŞ\üÜ]"
deg.Global = True
For a = 1 To [a65536].End(3).Row
veri = Right(deg.Replace(Cells(a, "a"), ""), 2)
Cells(a, "e") = Left(veri, 1)
Cells(a, "f") = Right(veri, 1)
Next
End Sub

Sub soniki()
Set deg = CreateObject("VBScript.Regexp")
deg.Pattern = "[^0-9,aA-zZ\çÇ\ğĞ\ıİ\öÖ\şŞ\üÜ]"
deg.Global = True
For d = 1 To [d65536].End(3).Row
veri = Right(deg.Replace(Cells(d, "d"), ""), 2)
Cells(d, "k") = Left(veri, 1)
Cells(d, "m") = Right(veri, 1)
Next
End Sub

Merhabalar
alttaki makroda yukarıdaki makrodan farklı olan kısımları kırmızı ile belirttim.
Bu makroları birleştirmek beni zaman kaybından kurtaracak.

kendim bir türlü yapamadım yardımlarınızı bekliyorum.

 

[hakantb]

Cells(a, "e") = Left(veri, 1)
Cells(d, "m") = Right(veri, 1)
Sayın ahzola
sizde benim gibi kod konusunda biraz zayıfsınız herhalde
Yukarıdaki satırlarda 1 yerine 2 yazarak deneyin değişikliği görünce size fikir verecegini sanıyorum kolay gelsin

 

[ahzola]

Yapamadım maalesef
next complate diye uyarı veriyor.

 

[Korhan Ayhan]

Tam olarak ne yapmak istiyorsunuz. Birleştirmekten kastınız sütun bilgisinimi değiştirmektir.

 

[ahzola]

Aşağıdaki kodu denermisiniz.

Sub soniki()
Set deg = CreateObject("VBScript.Regexp")
deg.Pattern = "[^0-9,aA-zZ\çÇ\ğĞ\ıİ\öÖ\şŞ\üÜ]"
deg.Global = True
For a = 1 To [a65536].End(3).Row
veri = Right(deg.Replace(Cells(a, "a"), ""), 2)
Cells(a, "e") = Left(veri, 1)
Cells(a, "f") = Right(veri, 1)
Next
End Sub

Merhaba

Sayın Ayhan.

Yukarıdaki makromuz çalışıyor hiçr bir sorun yok.
ben sadece ilave istemekteyim.

Makromuzun şimdiki hali :
A sütununa girilen veriyi (belirtilen kriterlere göre) e ve f hücrelerine yazıyor.

Makromuzun ilaveden sonraki hali
A sütununa girilen veriyi (belirtilen kriterlere göre) e ve f hücrelerine yazsın.
D sütununa girilen veriyi (belirtilen kriterlere göre) k ve m hücrelerine yazsın.

2 işlev yapacak yani.

Eğer mümkün ise kriterlerede bir ilave yapmak istemekteyim.
A ve D sütunlarında ki veriler tek hane olur ise ilgili satırı es geçsin.

umarım anlaşılır olmuştur

saygılarımla.

 

[Korhan Ayhan]

Aşağıdaki gibi deneyin.

Sub son()
    Set deg = CreateObject("VBScript.Regexp")
    deg.Pattern = "[^0-9,aA-zZ\çÇ\ğĞ\ıİ\öÖ\şŞ\üÜ]"
    deg.Global = True
    
    For a = 1 To [a65536].End(3).Row
        If Len(Cells(a, "a")) > 1 Then
            veri = Right(deg.Replace(Cells(a, "a"), ""), 2)
            Cells(a, "e") = Left(veri, 1)
            Cells(a, "f") = Right(veri, 1)
        End If
    Next
    
    For d = 1 To [d65536].End(3).Row
        If Len(Cells(d, "d")) > 1 Then
            veri = Right(deg.Replace(Cells(d, "d"), ""), 2)
            Cells(d, "k") = Left(veri, 1)
            Cells(d, "m") = Right(veri, 1)
        End If
    Next
End Sub

 

[ahzola]

Çok çok teşekkür ederim
Sayın Ayhan.

Ellerinize sağlık.