Makro ile özel birleştirme

[policeman]

Hayırlı Ramazanlar...
Değişik sütunlardaki bazı verileri makro ile (ekte anlattığım üzere) özel olarak birleştirmek ve benzersiz ID elde etmek istiyorum..
Yardımlarınızı bekliyor saygılarımı sunuyorum..

 

[Korhan Ayhan]

Deneyiniz.

Sub ID_Olustur()
    Dim Son As Long
    
    Range("A3:A" & Rows.Count).ClearContents
    
    Son = Cells(Rows.Count, 2).End(3).Row
    
    With Range("A3:A" & Son)
        .Formula = "=C3&"".""&LOOKUP(B3,{""Bakırköy"",""İstanbul"",""İstanbul Anadolu""},{""A01-"",""A02-"",""A03-""})&RIGHT(D3,2)&"".""&TEXT(E3,""00000"")&""-""&W3"
        .Value = .Value
    End With
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[policeman]

Sn. Korhan Ayhan..
Hızır gibi yetiştiniz;Allah razı olsun..
Tablom da şimdilik 2500 satırlık veri var ve giderek artıyor..
Makroyu çalıştırdığımda 3 dakika 53 saniyede tamamlanıyor;daha hızlı çalışmasının imkanı varmıdır?. Gerçi bu işimi görür ama hızlanabilirse daha iyi olur..
Yardımlarınız için tekrar teşekkürler,saygılarımla..

 

[policeman]

Sn. Korhan Ayhan..
YIL sütununda bulunan rakamın son iki hanesi devamlı 05 geliyor..
Oysa 2017 yazıyorsa 17, 2018 yazıyorsa 18 gelmesi gerekli..
Düzeltebilirseniz çok makbule geçecek..
Saygılarımla..

 

[policeman]

Konu günceldir arkadaşlar..

 

[policeman]

Sn. Korhan Ayhan..
YIL sütununda bulunan rakamın son iki hanesi devamlı 05 geliyor..
Oysa 2017 yazıyorsa 17, 2018 yazıyorsa 18 gelmesi gerekli..
Düzeltebilirseniz çok makbule geçecek..
Saygılarımla..

 

[Korhan Ayhan]

Merhaba,

Üstteki mesajımda ki kodu revize ettim.

Daha hızlı sonuç veriyor. Deneyiniz.

 

[policeman]

Sn. Korhan Ayhan..
Bir kez daha Allah razı olsun diyorum, 10 saniyede işlem tamam..
Ufak bir sorun var;C sütununda bulunan rakam çift hane olarak birleştirilmesi gerekli, tek rakamsa başına 0 gelmeli..
Saygılarımla..

 

[policeman]

Sn. Korhan Ayhan..
C3 yerine E3 örneğindeki gibi değişiklik yapınca sorun çözüldü;TEXT(C3,""00"")
Hakkınızı helal edin, çok teşekkürler..
Konu çözüme ulaşmıştır..
Saygılarımla..