Çoklu bul değiştir. Find Replace

[Bora K]

Merhabalar.

Çalışma kitabının açık olduğu durumlarda aşağıdaki kodu kullanıyorum.
Kod gayet işlevsel. Lakin değiştirme yapılacak dosya sayısı çok fazla
olduğu durumlarnda aşırı zaman kaybına neden oluyor.

Değerli uzmanlarımızdan Benzer formatta kapalı dosyalara uygulanacak
bir kod istemekteyim.
Saygılarımla.

Sub xxxx()
    Dim myList, myRange
    Set myList = Sheets("Sayfa1").Range("A3:B10") 'Değiştirilecek verilerin yazılacağı alan
    Set myRange = Sheets("Sayfa1").Range("D1:F100") 'Aranacak alan.
    For Each cel In myList.Columns(1).Cells
        myRange.Replace what:=cel.Value, Replacement:=cel.Offset(0, 1).Value
    Next cel
End Sub

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Seçtiğiniz klasördeki ve tüm alt klasörlerdeki dosyaların içindeki tüm sayfalarda işlem yapar. Bu kod yapısını tüm kapalı dosya işlemlerinizde üzerinde oynamalar yaparak kullanabilirsiniz.

Sub Klasor_Altindaki_Dosyalarda_Bul_Degistir()
    Dim klasor As Object
     
    Set klasor = CreateObject("Shell.Application").BrowseForFolder _
                        (0, "Lütfen bir klasor seçin !", 1)
    
    If klasor Is Nothing Then Exit Sub
                        
    Application.ScreenUpdating = False
    Liste (klasor.Items.Item.Path)
    AltListe (klasor.Items.Item.Path)
    Application.ScreenUpdating = True
    
    Set klasor = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Private Sub Liste(yol As String)
    Dim s1 As Worksheet, aranacak_veri As Range, veri As Range, dosya As String, k1 As Workbook, sayfa As Worksheet
 
    Set s1 = ThisWorkbook.Worksheets("Değişiklik listesi")
    Set aranacak_veri = s1.Range("B4:D" & s1.Cells(Rows.Count, 2).End(3).Row)
 
    dosya = Dir(yol & "\*.*")
    
    While dosya <> ""
        DoEvents
        Set k1 = Workbooks.Open(yol & "\" & dosya)
        For Each sayfa In k1.Worksheets
            For Each veri In aranacak_veri.Columns(1).Cells
                If WorksheetFunction.CountIf(sayfa.Range("A1:G100"), veri) > 0 Then
                    sayfa.Range("A1:G100").Replace veri, veri.Offset(0, 2).Value[COLOR="Red"], xlWhole[/COLOR]
                    veri.Offset(0, 4) = "X"
                Else
                    veri.Offset(0, 4) = ""
                End If
            Next
        Next
        k1.Close 1
        dosya = Dir
    Wend
    
    Set s1 = Nothing
    Set aranacak_veri = Nothing
End Sub
 
Private Sub AltListe(yol As String)
    Dim fL As Object, f As Object, dosya As String, j As Long
    Dim s1 As Worksheet, aranacak_veri As Range, veri As Range, k1 As Workbook, sayfa As Worksheet
    
    Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders
    Set s1 = ThisWorkbook.Worksheets("Değişiklik listesi")
    Set aranacak_veri = s1.Range("B4:D" & s1.Cells(Rows.Count, 2).End(3).Row)
     
    On Error GoTo sonraki
    For Each f In fL
        dosya = Dir(f.Path & "\*.*")
        
        While dosya <> ""
            DoEvents
            Set k1 = Workbooks.Open(f.Path & "\" & dosya)
            For Each sayfa In k1.Worksheets
                For Each veri In aranacak_veri.Columns(1).Cells
                    If WorksheetFunction.CountIf(sayfa.Range("A1:G100"), veri) > 0 Then
                        sayfa.Range("A1:G100").Replace veri, veri.Offset(0, 2).Value[COLOR="Red"], xlWhole[/COLOR]
                        veri.Offset(0, 4) = "X"
                    Else
                        veri.Offset(0, 4) = ""
                    End If
                Next
            Next
            k1.Close 1
            dosya = Dir
        Wend
        
        AltListe (f.Path)
sonraki:
    Next
    
    Set s1 = Nothing
    Set aranacak_veri = Nothing
    Set fL = Nothing
End Sub

 

[Bora K]

Korhan Hocam
Alakanız ve yardımınız için çok çok
teşekkür ediyorum.

Kodu denedim farklı verilerede işlem yapmakta.
ekteki dosyaya bakabilirmisiniz acaba?

 

[Korhan Ayhan]

Merhaba,

Üstteki mesajımdaki koda kırmızı renkli eklemeleri yaptım. Bu ifade birebir eşleştirme için kullanılır. Eğer büyük-küçük harf duyarlı olmasını da isterseniz kırmızı bölümü aşağıdaki gibi düzenlemeniz gerekir.

, xlWhole, , True

 

[Bora K]

Merhabalar Sayın Hocam
Acaba yanlışmı yaptım bu satırda hata veriyor.
True i kaldırınca çalışıyor bu kezde Büyük Küçük harf duyarlılığını kaybediyor.

sayfa.Range("A1:G100").Replace veri, veri.Offset(0, 2).Value, xlWhole, True

 

[Korhan Ayhan]

Evet yanlış yazmışsınız.
True ifadesinden önce iki virgül olmalıdır.

 

[Bora K]

İlk önce özür diliyor.
Sonra çok ve çok teşekkür ediyorum.
Değerli hocam.

Herşey gönlünüzce olsun.
Saygılarımla.