Makro ile Kod değişimlerini yer değiştirme

eceLprensi

Altın Üye
Katılım
30 Ekim 2007
Mesajlar
97
Excel Vers. ve Dili
2016
Altın Üyelik Bitiş Tarihi
29-06-2025
Merhaba, Üstadlarım,
Ekteki dosyadaki gibi Liste sayfamda kod ve adlar mevcut.

ama Kontrol sayfasındaki gibi a2 deki kodu bulup yanındaki kod ve ad ile değiştirmesini nasıl sağlayabilirim.

Saygılarımla
Teşekkürler.
 

Ekli dosyalar

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,647
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub test()
    Dim w(1 To 2), ver, i&, sL As Worksheet
    Set sL = Sheets("Liste")
    With Sheets("Kontrol sayfası")
        ver = .Range("A2:C" & .Cells(Rows.Count, 1).End(3).Row)
    End With
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ver)
            w(1) = ver(i, 2)
            w(2) = ver(i, 3)
            .Item(ver(i, 1)) = w
        Next i
        For i = 2 To sL.Cells(Rows.Count, 1).End(3).Row
            If .exists(sL.Cells(i, 1).Value) Then
                sL.Cells(i, 1).Resize(, 2).Value = .Item(sL.Cells(i, 1).Value)
            End If
        Next i
    End With
End Sub
 

eceLprensi

Altın Üye
Katılım
30 Ekim 2007
Mesajlar
97
Excel Vers. ve Dili
2016
Altın Üyelik Bitiş Tarihi
29-06-2025
merhaba

Üstadım bira fazla oluyorum ama :) sevgilerimle

Diğer 3 sütunuda değiştirmem gerekiyor.
Ekte örnek var.
Bi el daha desteklesen @veyselemre Üstadım
 

Ekli dosyalar

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,647
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub test()
    Dim w(1 To 5), ver, i&, sL As Worksheet
    Set sL = Sheets("Liste")
    With Sheets("Kontrol sayfası")
        ver = .Range("A2:F" & .Cells(Rows.Count, 1).End(3).Row)
    End With
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ver)
            w(1) = ver(i, 2)
            w(2) = ver(i, 3)
            w(3) = ver(i, 4)
            w(4) = ver(i, 5)
            w(5) = ver(i, 6)
            .Item(ver(i, 1)) = w
        Next i
        For i = 2 To sL.Cells(Rows.Count, 1).End(3).Row
            If .exists(sL.Cells(i, 1).Value) Then
                sL.Cells(i, 1).Resize(, 5).Value = .Item(sL.Cells(i, 1).Value)
            End If
        Next i
    End With
End Sub
 

eceLprensi

Altın Üye
Katılım
30 Ekim 2007
Mesajlar
97
Excel Vers. ve Dili
2016
Altın Üyelik Bitiş Tarihi
29-06-2025
Ellerinize sağlık. Çok teşekkür ederim. hayat kurtardınız.
@veyselemre emeklerinize sağlık.
 
Üst