İşlemi tüm dosyaya uygulama

[Serdarrk]

Merhaba,

Aşağıdaki dosyada ve bunun gibi 20 ayrı dosyanın her birinde yaklaşık 250'şer sayfa bulunmakta. Amacım, diğer dosyalarda sütun isimleri değişmekle birlikte bu dosya için ; (I+U) / (J+V), I sütunu ve U sütunu toplamını J ve V sütunlarının toplamına bölmek, bu işlemi tüm dosyada uygulayıp sonuçları Y sütununda görmek. Bunu makro yada başka bir yolla yapmak mümkün müdür?


http://s7.dosya.tc/server3/lryuu1/01.02.1999-1.xls.html

 

[Muzaffer Ali]

Merhaba

Aşağıdaki kodu kullanabilirsiniz.

Sub ToplamaYap()
    Dim Dizin As String
    Dim Obj
    Dim ExD As Workbook
    Dim ExS As Worksheet
    Dim SonSatir As Long
    Dim Klasor As Scripting.Folder, Dosya As Scripting.File
    Set Obj = CreateObject("Scripting.FileSystemObject")
    
    Dizin = "c:\KlasorAdi" 'Buraya dosyalarınızın bulunduğu klasör adresini yazınız.
    
    Set Klasor = Obj.GetFolder(Dizin)
    For Each Dosya In Klasor.Files
      If InStr(Dosya.Name, ".xls") > 0 Or InStr(Dosya.Name, ".xlsx") > 0 Then
         Set ExD = Workbooks.Open(Dosya.Path)
         For Each ExS In ExD.Sheets
            SonSatir = ExS.Cells(Rows.Count, "I").End(3).Row
            ExS.Range("Y2:Y" & SonSatir).Formula = "=(I2+U2) / (J2+V2)"
         Next
         ExD.Close True
      End If
    Next
End Sub

 

[Muzaffer Ali]

Tüm verilerin 2. satırdan başladığı varsayılmıştır.
Değiştirmek isterseniz, aşağıdaki satırdaki tüm 2 rakamlarını değiştirmelisiniz.

ExS.Range("Y2:Y" & SonSatir).Formula = "=(I2+U2) / (J2+V2)"

 

[Serdarrk]

İlginiz ve emeğiniz için çok teşekkür ederim ancak kodu çalıştırdığımda Klasor As Scripting.Folder kısmında hata vermekte. Neyi yanlış yaptım acaba?

Sub ToplamaYap()
    Dim Dizin As String
    Dim Obj
    Dim ExD As Workbook
    Dim ExS As Worksheet
    Dim SonSatir As Long
    Dim Klasor As Scripting.Folder, Dosya As Scripting.File
    Set Obj = CreateObject("Scripting.FileSystemObject")
    
    Dizin = "C:\Users\serdar\Desktop\YILLIK-2\1999"
    
    Set Klasor = Obj.GetFolder(Dizin)
    For Each Dosya In Klasor.Files
      If InStr(Dosya.Name, ".xls") > 0 Or InStr(Dosya.Name, ".xlsx") > 0 Then
         Set ExD = Workbooks.Open(Dosya.Path)
         For Each ExS In ExD.Sheets
            SonSatir = ExS.Cells(Rows.Count, "I").End(3).Row
            ExS.Range("Y4:Y" & SonSatir).Formula = "=(I4+U4) / (J4+V4)"
         Next
         ExD.Close True
      End If
    Next
End Sub

 

[Muzaffer Ali]

Bu kodları kopyaladığınız dosyayı açın yukarıdaki menülerden
Tools / Referances seçin, açılan listeden
Microsoft Scripting Runtime bulun yanındaki onay kutusunu işaretleyin. Tamam ı tıklatın

 

[Serdarrk]

Mükemmel çalışıyor. Emeğinize ve ayırdığınız vaktinize çok teşekkür ederim. Son olarak bir konuda daha yardımınıza ihtiyacım var. Yukarıda ki dosyada A ve M sütunlarında > işaretli satırları filitrelemem gerekmekte. Bunu tüm dosyaya uygulamak mümkün müdür?

 

[Muzaffer Ali]

Aşağıdaki kod ile mümkün.

Sub ToplamaYap()
    Dim Dizin As String
    Dim Obj As New Scripting.FileSystemObject
    Dim ExD As Workbook
    Dim ExS As Worksheet
    Dim SonSatir As Long
    Dim SonKolon As Long
    Dim Klasor As Scripting.Folder, Dosya As Scripting.File

    Dizin = "C:\Users\serdar\Desktop\YILLIK-2\1999"
    
    Set Klasor = Obj.GetFolder(Dizin)
    For Each Dosya In Klasor.Files
      If InStr(Dosya.Name, ".xls") > 0 Or InStr(Dosya.Name, ".xlsx") > 0 Then
         Set ExD = Workbooks.Open(Dosya.Path)
         For Each ExS In ExD.Sheets
            SonSatir = ExS.Cells(Rows.Count, "I").End(3).Row
            SonKolon = ExS.Cells(2, Columns.Count).End(1).Column
            ExS.Range("Y4:Y" & SonSatir).Formula = "=(I4+U4) / (J4+V4)"
            ExS.Range("A2:" & Cells(SonSatir, SonKolon).Address).AutoFilter Field:=1, Criteria1:="=>", Operator:=xlAnd
            ExS.Range("A2:" & Cells(SonSatir, SonKolon).Address).AutoFilter Field:=13, Criteria1:="=>", Operator:=xlAnd
         Next
         ExD.Close True
      End If
    Next
End Sub

 

[Serdarrk]

Sizi de yordum kusura bakmayın. Çok teşekkür ederim.

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.

 

[Serdarrk]

Rica ederim. Kolay gelsin.

Kusura bakmayın sizi tekrar rahatsız ediyorum ama işlem ve filtreleme kodunu birlikte çalıştırdığımda bazı hatalar oluştu. Filtreleme için ayrı ve tek bir kodla yardım edebilir misiniz ?

 

[Muzaffer Ali]

Excel hata mı veriyor.
Verdiği hatayı da yazsaydınız belki yardımcı olabilirdim.

Şu satırı silerseniz sadece filtreleme yapar

ExS.Range("Y4:Y" & SonSatir).Formula = "=(I4+U4) / (J4+V4)"

 

[Serdarrk]

Yok hayır excelde yada kodda her hangi bir sıkıntı yok. Sadece bazı sayfalarda tanımlanan sütuna kadar veri olmadığı için o sayfalarda çalışma duruyordu. O yüzden filtrelemeyi ayrıca uygulamak istedim.Çok teşekkür ederim. Son olarak bazı dosyalarda bu filtrelemeyi A ve örneğin S sütununa uygulamak istediğim de aşağıdaki kodda Field:=13 kısmını değiştirmem yeterli olur mu?

ExS.Range("A2:" & Cells(SonSatir, SonKolon).Address).AutoFilter Field:=1, Criteria1:="=>", Operator:=xlAnd
            ExS.Range("A2:" & Cells(SonSatir, SonKolon).Address).AutoFilter Field:=13, Criteria1:="=>", Operator:=xlAnd

 

[Muzaffer Ali]

Evet Field:=13 kısmını değiştirmeniz yeterli.

13 yerine kaç yazarsanız o kolonda filtreleme yapar.

 

[Serdarrk]

Yardımlarınız için teşekkür ederim.