Bul değiştir veya Sıradakini sonraki sütüna yaz

[mhrcvk]

Değerli Arkadaşlar Merhaba,

Daha önce manuel olarak yaptığım bir çalışmayı revize etmem gerekiyor. Sayfa1de D sütünunda olan değerler sayfa2de D-AB sütün aralığında bulunmaktadır. ilgili değerleri sayfa1 deki E sütunundaki değerler ile değiştirmek istiyorum tekrar manuel yapmak çok uğraştıracak acil destek bekliyorum. Şimdiden emeğinize sağlık.

 

[Korhan Ayhan]

Deneyiniz.

Sub TEST()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, X As Long
    
    Set S1 = Sheets("sayfa 1")
    Set S2 = Sheets("sayfa2")
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    For X = 2 To Son
        S2.Cells.Replace S1.Cells(X, 4), S1.Cells(X, 5), xlWhole
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Asri]

Alternatif;

Sub bul_yerlestir()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Set sh2 = Sheets("sayfa2")
   Set sh1 = Sheets("sayfa 1")
   sonsatir2 = sh2.Cells(Rows.Count, "C").End(3).Row
   sh2.Range("D3:AB" & sonsatir2).ClearContents
   
   For i = 3 To sonsatir2
     kod2 = sh2.Cells(i, "C").Value
     sonsatir1 = sh1.Cells(Rows.Count, "A").End(3).Row
     kolon = 3
     For j = 2 To sonsatir1
        kod1 = sh1.Cells(j, "A").Value
        kullanici = sh1.Cells(j, "D").Value
        If kod2 = kod1 Then
           kolon = kolon + 1
           sh2.Cells(i, kolon).Value = kullanici
        End If
     Next j
   Next i
   
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub

 

[mhrcvk]

Deneyiniz.

Sub TEST()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, X As Long
    
    Set S1 = Sheets("sayfa 1")
    Set S2 = Sheets("sayfa2")
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    For X = 2 To Son
        S2.Cells.Replace S1.Cells(X, 4), S1.Cells(X, 5), xlWhole
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Korhan Bey,

Kusura bakmayın göndermiş olduğum ekte belirtilen işlemi yaptı fakat benim kullandığım eke göre uyarlamasını yapamadım eki yeniden revize ettim zahmet olmaz ise yardımcı olur musunuz ?

 

[mhrcvk]

Alternatif;

Sub bul_yerlestir()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Set sh2 = Sheets("sayfa2")
   Set sh1 = Sheets("sayfa 1")
   sonsatir2 = sh2.Cells(Rows.Count, "C").End(3).Row
   sh2.Range("D3:AB" & sonsatir2).ClearContents
   
   For i = 3 To sonsatir2
     kod2 = sh2.Cells(i, "C").Value
     sonsatir1 = sh1.Cells(Rows.Count, "A").End(3).Row
     kolon = 3
     For j = 2 To sonsatir1
        kod1 = sh1.Cells(j, "A").Value
        kullanici = sh1.Cells(j, "D").Value
        If kod2 = kod1 Then
           kolon = kolon + 1
           sh2.Cells(i, kolon).Value = kullanici
        End If
     Next j
   Next i
   
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub

Asri bey ,

Yardımınız için teşekkür ederim fakat kod doğru çalışmıyor isteğimden farklı bir çalışma yürütüyor.

 

[mhrcvk]

Konu hakkında sorun devam etmektedir.