Excel'de Klasör ve Alt Klasörlerde Toplu Bul ve Değiştir Makrosu çok önemli

[samtual]

Arkadaşlar binlerce Excel dosyası var ve bu dosyaların içinde, değişik sütun ve satırlardaki hücrelerde örn. KA61548 şeklinde değerler yer almakta.
Bu KA61548 değerinin KA'nın sağındaki sayılar değişti.
Şimdi benim bir listem var Excel'de, Sol sütunda eski kod, sağ tarafta yeni kod.

Öyle bir makro yapmalıyımki, çalıştırdığımda seçtiğim tüm klasör ve alt klasörleri tarayarak, soldaki değeri bulup sağdaki ile değiştirmeli. Çok mühim bir konu, yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

Bulduğum ve çalıştıramadığım kod;

Sub MAIN()
    DoReplacements "C:\"
End Sub

Sub DoReplacements(sSourceFolder As String)
    
    Set fldr = CreateObject("scripting.filesystemobject").getfolder(sSourceFolder)
    
    For Each fl In fldr.Files
        If Right(fl.Name, 5) = ".xls" Then
            For Each r In Columns(1).SpecialCells(2)
                Debug.Print "Begin:", fldr.Path & "\" & fl.Name, r.Text, r.Offset(, 1).Text
                ReplaceTextInFile fldr.Path & "\" & fl.Name, r.Text, r.Offset(, 1).Text
            Next
        End If
    Next

    For Each SubFolder In CreateObject("scripting.filesystemobject").getfolder(sSourceFolder).SubFolders
        DoReplacements SubFolder.Path
    Next SubFolder

End Sub

Sub ReplaceTextInFile(SourceFile As String, _
                      sText As String, _
                      rText As String)

    Open SourceFile For Input As #1
    c0 = Input(LOF(1), #1)
    Close #1

    Open SourceFile For Output As #1
    Print #1, Replace(c0, sText, rText)
    Close #1
    
End Sub

 

[tahsinanarat]

Ekli dosyayı inceleyin

Ekli dosya işinizi görecektir, Evvelce bu siteden temin etmiştim.

 

[kucukdunyam]

Merhabalar, konunun benzerinde olduğu için ben de yardım isteyebileceğim bir konuyu paylaşmak istiyorum.

Kod kapalı word dosyasının içinde üst bilgi kısmını bul-değiştir yaptırıyor. Ancak bu işlemi klasör seçerek yaptırmak istiyorum. A klasörünü seçtiğimde, bu klasörün içindeki ve varsa alt klasörlerin de içindeki word dosyasını açıp bul değiştir işlemini yaptırıp kapatsın istiyorum. Yardımcı olursanız çok sevinirim.


Sub WD_Altbilgi()
eskibilgi = Application.InputBox("ESKİ BİLGİ veri girişi yapınız.", "eskibilgi", ActiveSheet.Range("f1").Value)
If eskibilgi = False Then Exit Sub
yenibilgi = Application.InputBox("YENİ BİLGİ için veri girişi yapınız.", "yenibilgi", ActiveSheet.Range("f2").Value)
If yenibilgi = False Then Exit Sub
Set WD = CreateObject("word.Application")
WD.Visible = True
Yol = ThisWorkbook.Path
Dosya = Dir(Yol & "\*doc*")
Do While Dosya <> ""
WD.Application.Documents.Open Yol & "\" & Dosya
WD.Selection.Find.ClearFormatting
WD.Selection.Find.Replacement.ClearFormatting
WD.ActiveWindow.ActivePane.View.SeekView = 10
WD.ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = False
With WD.Selection.Find
.Text = eskibilgi
.Replacement.Text = yenibilgi
.Forward = True
.Wrap = 1
End With
WD.Selection.Find.Execute Replace:=2
WD.ActiveDocument.Close True
Dosya = Dir
Loop
WD.Application.Quit
MsgBox "İşlem tamamlanmıştır.", vbInformation, " - "
End Sub