Birden fazla dosya da toplu değiştirme olurmu ?

[ulashb]

Arkadaşlar işim gereği yazdığım raporların bazen sadece tarihlerini değiştirmem gerekiyor, yüzlerce dosyayı teker teker açıp, tarihleri ve dosya numaralarını değiştirmek çok zor olmaya başladı bunun kolay bir yolu varmı ?
Birkaç örnek dosya yükledim, sağ üst tarafta rapor tarihi, kontrol tarihi yazan yerleri 07.09.2012 den 05.10.2012 ye değiştirmem gerek mesela bunun gibi yüz tane dosya toplu şekilde değişirmi ?

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp dener misiniz?.

Sub Gunle()
 
    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
    
    Range("A:A").ClearContents
    [A1] = "GÜNLENEN DOSYALAR"
    
    Liste (Klasor.Items.Item.Path)
     
    Set Klasor = Nothing
    
End Sub

Sub Liste(yol As String)
    Dim Dosya           As String, _
        Dos             As String, _
        i               As Long, _
        KontrolTarihi   As Date, _
        RaporTarihi     As Date, _
        RaporNo, _
        Numara          As Integer
        
     
    Application.ScreenUpdating = False
    
    KontrolTarihi = Range("D1")
    RaporTarihi = Range("D2")
    
    Dosya = Dir(yol & "\*.xl*")
    
    i = 1
    
    While Dosya <> ""
    
        DoEvents
        If Dosya Like "yemek*" Then
            i = i + 1
            Dos = yol & "\" & Dosya
            Cells(i, 1) = Dos
            Workbooks.Open Filename:=Dos
            Range("AW11") = Format(KontrolTarihi, "dd.mm.yyyy")
            Range("AW12") = Format(RaporTarihi, "dd.mm.yyyy")
            RaporNo = Split(Range("AW13"), "-")
            Numara = Val(RaporNo(3)) + 1
            Range("AW13") = RaporNo(0) & "-" & RaporNo(1) & "-" & RaporNo(2) & "-" & _
                Format(Numara, "000")
            
            ActiveWorkbook.Close SaveChanges:=True
        End If
        Dosya = Dir
        
    Wend
    
    Application.ScreenUpdating = True
    
    MsgBox i - 1 & " Adet Dosya Güncellenmiştir...", vbInformation, "ExcelWebTr"
    
End Sub

 

[Necdet]

Tekrar merhaba,

Her ne kadar soruyu soran arkadaşımız herhangi bir yorum ve geri dönüş yapmamış olsa da biz desteğe devam edelim.

Topluca günlemede sadece 2 hücre değil birden fazla hücreyi de günler hale getirdim.

Parametrik oldu.

Sub Gunle()
 
    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
    Range("A:A").ClearContents
    [A1] = "Günlenen Dosyalar"
 
    Liste (Klasor.Items.Item.Path)
 
    Set Klasor = Nothing
 
End Sub

Sub Liste(yol As String)
 
    Dim Dizi()  As String, _
        Dosya   As String, _
        Dos     As String, _
        Rng     As String, _
        i       As Long, _
        j       As Integer, _
        Son     As Integer
 
    Application.ScreenUpdating = False
 
    Sheets("Sayfa1").Select
 
    Son = Cells(Rows.Count, "C").End(3).Row
 
    If Son < 2 Then
        MsgBox "Günlenecek Hücreleri Belirtmemişsiniz, ÇIKIYORUM", vbCritical, "Excel.Web.Tr"
        Exit Sub
    End If
 
    ReDim Dizi(0 To Son - 2, 1)
 
    For j = 2 To Son
        Dizi(j - 2, 0) = Cells(j, "C")
        Dizi(j - 2, 1) = Cells(j, "D")
    Next j
 
    Dosya = Dir(yol & "\*.xl*")
 
    i = 1
 
    While Dosya <> ""
 
        DoEvents
        If Dosya Like "yemek kazan*" Then
            i = i + 1
            Dos = yol & "\" & Dosya
            Cells(i, 1) = Dos
 
            Workbooks.Open Filename:=Dos
 
            For j = 0 To UBound(Dizi)
                Rng = Dizi(j, 0)
                Range(Rng) = Dizi(j, 1)
            Next j
 
            ActiveWorkbook.Close SaveChanges:=True
        End If
 
        Dosya = Dir
 
    Wend
 
    Application.ScreenUpdating = True
 
    MsgBox i - 1 & " Adet Dosya Güncellenmiştir...", vbInformation, "ExcelWebTr"
 
End Sub

 

[ulashb]

Üstadım bu harika bişey olmuş, eline sağlık. Vallahi büyük bir dertten kurtardın beni, şimdi buna üçüncü bi satır daha ekleyebilrbiyiz, ama bu biraz daha faklı rapor no yazan kısımda ikinci bölüm var 493-07-YK-001 07 yazan bölüm, bunu her seferinde bir artırmam gerekiyor, bu mümkünmüdür. Zaten buda son bunu da yapınca hepsi tek sefer de olmuş olacak.

 

[Necdet]

Merhaba,

2 nolu mesajı değiştirdim. 3 nolu mesajdaki dosya parametrikti, o genel olarak kalsın istedim.

2 nolu mesajdaki dosyayı ve kodları kullanabilirsiniz.