anahtar kelimelerle düşeyara makrosu

[kakara]

merhaba değerli üstadlarım anahtar kelımelerle düşeyara makrosu olusturabılır mıyız ? sayfa 1 de olan kelımelerı sayfa 2 de olan kelımelerle değiştirmek ıstıyorum. detaylı bılgıyı ektekı dosya da acıkladım.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub N_Sutununu_Ingilizceye_Donustur()
    Dim S1 As Worksheet, S2 As Worksheet, Aranan As Range, Say As Long
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    For Each Aranan In S2.Range("A2:A" & S2.Cells(Rows.Count, 1).End(3).Row)
        Say = Say + WorksheetFunction.CountIf(S1.Range("N:N"), Aranan.Value)
        S1.Range("N:N").Replace Aranan.Value, Aranan.Offset(0, 1).Value, xlWhole
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox Say & " adet veri değiştirilmiştir.", vbInformation
End Sub

Sub T_Sutununu_Ingilizceye_Donustur()
    Dim S1 As Worksheet, S2 As Worksheet, Aranan As Range, Say As Long
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    For Each Aranan In S2.Range("D2:D" & S2.Cells(Rows.Count, 4).End(3).Row)
        Say = Say + WorksheetFunction.CountIf(S1.Range("T:T"), Aranan.Value)
        S1.Range("T:T").Replace Aranan.Value, Aranan.Offset(0, 1).Value, xlWhole
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox Say & " adet veri değiştirilmiştir.", vbInformation
End Sub

Sub C_Sutununu_Ingilizceye_Donustur()
    Dim S1 As Worksheet, S2 As Worksheet, Aranan As Range, Say As Long
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    For Each Aranan In S2.Range("G2:G" & S2.Cells(Rows.Count, 7).End(3).Row)
        Say = Say + WorksheetFunction.CountIf(S1.Range("C:C"), Aranan.Value)
        S1.Range("C:C").Replace Aranan.Value, Aranan.Offset(0, 1).Value, xlWhole
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox Say & " adet veri değiştirilmiştir.", vbInformation
End Sub

 

[kakara]

@Korhan Ayhan ustadım kod cok ıyı calısıyor sadece bıraz zaman alıyor degıstırırken ama bu bıle mukemmel tesekkurler

 

[Korhan Ayhan]

Anladım.

Daha hızlı sonuç için deneyiniz.

Paylaştığım iki kod arasındaki hız farkını da yazarsanız sevinirim.

Option Explicit

Sub N_Sutununu_Ingilizceye_Donustur()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Say As Long
    Dim Son As Long, Veri As Variant, X As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = S2.Range("A2:B" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        Dizi.Item(Veri(X, 1)) = Veri(X, 2)
    Next
    
    Son = S1.Cells(S1.Rows.Count, 14).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = S1.Range("N2:N" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        If Dizi.Exists(Veri(X, 1)) Then
            If Veri(X, 1) <> Dizi.Item(Veri(X, 1)) Then
                Say = Say + 1
                Veri(X, 1) = Dizi.Item(Veri(X, 1))
            End If
        End If
    Next
    
    S1.Range("N2").Resize(UBound(Veri)) = Veri
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
    
    MsgBox Say & " adet veri değiştirilmiştir." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Sub T_Sutununu_Ingilizceye_Donustur()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Say As Long
    Dim Son As Long, Veri As Variant, X As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Son = S2.Cells(S2.Rows.Count, 4).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = S2.Range("D2:E" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        Dizi.Item(Veri(X, 1)) = Veri(X, 2)
    Next
    
    Son = S1.Cells(S1.Rows.Count, 20).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = S1.Range("T2:T" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        If Dizi.Exists(Veri(X, 1)) Then
            If Veri(X, 1) <> Dizi.Item(Veri(X, 1)) Then
                Say = Say + 1
                Veri(X, 1) = Dizi.Item(Veri(X, 1))
            End If
        End If
    Next
    
    S1.Range("T2").Resize(UBound(Veri)) = Veri
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
    
    MsgBox Say & " adet veri değiştirilmiştir." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Sub C_Sutununu_Ingilizceye_Donustur()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Say As Long
    Dim Son As Long, Veri As Variant, X As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Son = S2.Cells(S2.Rows.Count, 7).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = S2.Range("G2:H" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        Dizi.Item(Veri(X, 1)) = Veri(X, 2)
    Next
    
    Son = S1.Cells(S1.Rows.Count, 3).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = S1.Range("C2:C" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        If Dizi.Exists(Veri(X, 1)) Then
            If Veri(X, 1) <> Dizi.Item(Veri(X, 1)) Then
                Say = Say + 1
                Veri(X, 1) = Dizi.Item(Veri(X, 1))
            End If
        End If
    Next
    
    S1.Range("C2").Resize(UBound(Veri)) = Veri
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
    
    MsgBox Say & " adet veri değiştirilmiştir." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[kakara]

@Korhan Ayhan ustadım ılk kod da duzeltmelerın toplamı 6-7 dakıkada bıterken ıkıncı yazdıgınız kodda 1 dakıka bıle surmuyor. ellerınıze saglık tekrar tesekkur ederım