Listeye göre değer değiştirme

[ccuneyt13]

Merhaba,

Sub NumaraDuzelt ()
Dim S1 As Worksheet
Set S1 = ThisWorkbook.Sheets("Sayfa1")
lastRow = S1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
    Select Case S1.Cells(i, "H")
        Case 1101261189
            S1.Cells(i, 7) = "AA"
        'Case 1101261224
         '   S1.Cells(i, 7) = "BB"
        'Case 1100290740
        '    S1.Cells(i, 7) = "CC"
        '    Case 1101288755
        '    S1.Cells(i, 7) = "DD"
        Case Else
                    ' Do nothing
    End Select
Next
MsgBox "İşlem tamamlandı", vbInformation, "Bitti"
End Sub

Bu kod da Case ile belirtilen değere ait satırdaki G hücre değerini şu yap diye değiştiriyorum.
Örnek: Sayfa1 H3 = 1101261189 ise Sayfa1 G3 "AA" yapıyor.

Yapmak istediğim bir sürü değişiklik için kod'a tek tek Case eklemek yerine, aynı çalışma kitabında Sayfa2'de A2 den başlayarak değişkeni bulup, yine Sayfa2 B2 de yazılan metin değer ile değiştirmesini sağlamak istiyorum.
Sayfa2 A2'den itibaren 1101261189 bunun gibi numaralar, B2'den itibaren "Metin Ne yazılacaksa" onlar olacak.

Sayfa1 de Case olarak ifade edilen bir değer H sütununda birden çok kere geçiyor olabilir her satırdakini değiştirecek.
Sayfa2 de yinelenen değer olmayacak. A sütununda değiştirilecek numara, B sütununda Metin değer.

Veri sayısı çok olduğu için hızlı çalışacak bir yöntem arıyorum.

Saygılar.

 

[veyselemre]

Sub test()
    Dim s, i, ii
    s = Sheets("Sayfa2").Range("A2:B" & Sheets("Sayfa2").Cells(Rows.Count, 2).End(3).Row).Value
    With Sheets("Sayfa1")
        For i = 1 To UBound(s)
            For ii = 2 To .Cells(Rows.Count, "H").End(3).Row
                If .Cells(ii, "G").Value = "" Then
                    If InStr(.Cells(ii, "H").Value, s(i, 1)) > 0 Then .Cells(ii, "G").Value = s(i, 2)
                End If
            Next ii
        Next i
    End With
    MsgBox "İşlem tamamlandı", vbInformation, "Bitti"
End Sub

Sub test2()
    Dim s, i, ii, dic As Object
    s = Sheets("Sayfa2").Range("A2:B" & Sheets("Sayfa2").Cells(Rows.Count, 2).End(3).Row).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(s)
        If s(i, 1) <> "" Then dic.Item(s(i, 1)) = s(i, 2)
    Next i
    With Sheets("Sayfa1")
        For i = 2 To .Cells(Rows.Count, "H").End(3).Row
            If dic.exists(.Cells(i, "H").Value) Then
                .Cells(i, "G").Value = dic.Item(.Cells(i, "H").Value)
            End If
        Next i
    End With
    MsgBox "İşlem tamamlandı", vbInformation, "Bitti"
End Sub

 

[ccuneyt13]

Veysel Bey Merhaba,
Hızlı dönüşünüz için teşekkürlerimi, örnek dosya koymadan sorduğum içinde özürlerimi iletiyorum,

İlettiğiniz kodu ekli örnek dosyaya da orijinal dosyama da uyguladım ama herhangi bir değeri değiştirmedi.
Ekli dosyada ALİ'leri AA Velileri BB yapması lazım ama olmadı.


Siz Test2 'yi paylaşmadan önce yazmıştım cevabımı revize ediyorum.
Test2 çalışıyor. Performansı için ana tablomda deneyip iletiyorum sonucu
Saygılar.

 

[ccuneyt13]

Veysel Bey,
test2 olarak paylaştığınız kod harika ötesi çok ama çok teşekkür ederim.
1 saniye bile sürmüyor diyebilirim.
Saygılar