birden fazla dosyadan toplam alma

manonfire

Altın Üye
Katılım
24 Mayıs 2008
Mesajlar
57
Excel Vers. ve Dili
365 pro tr + 2016 pro plus tr
Altın Üyelik Bitiş Tarihi
29-12-2026
merhaba arkadaşlar,
ekte kesin hesap mali toplam dosyasına, kesin ataşman k01 ve kesin ataşman k02 gibi yüzlerce dosyanın yazmış olduğum formüllere göre koşullu olarak fonksiyonla toplamlarını almasını istiyorum fakat bunu yaparken dosya sayısından dolayı tıkandım yardımcı olurmusunuz.
 

Ekli dosyalar

manonfire

Altın Üye
Katılım
24 Mayıs 2008
Mesajlar
57
Excel Vers. ve Dili
365 pro tr + 2016 pro plus tr
Altın Üyelik Bitiş Tarihi
29-12-2026
arkadaşlar bir çözümü yok mudur bunun acil cevaplarınızı bekliyorum.
 

antonio

Destek Ekibi
Destek Ekibi
Katılım
13 Şubat 2011
Mesajlar
1,161
Excel Vers. ve Dili
Microsoft Office Professional Plus 2013 Türkçe
Merhaba,
Veri alınacak sayfalardaki verilerin başlama satırları farklı. Bir sayfada 52.satırdan başlarken, diğerinde 62.nci veya 57.nci satırdan başlayabiliyor.
Veri alınacak alt dosyaların standart bir satır-sütun yapısı olabilir mi, yoksa bu elinizde olmayan bir durum mudur?
 

manonfire

Altın Üye
Katılım
24 Mayıs 2008
Mesajlar
57
Excel Vers. ve Dili
365 pro tr + 2016 pro plus tr
Altın Üyelik Bitiş Tarihi
29-12-2026
merhaba antonio,
kaynak liste olarak pozlar dosyasını kullanıyor k01 ve k02 içindeki ataşman sayfalarından detayı sonrasında k01 ve k102 nin mali sayfasına detaydaki toplamları poz no ve imalat cinsini doğrulayarak miktarını yazıyor.

aynı işlemi kesin hesap mali toplam dosyasınada yaptım bu şekilde hem el değmeden otomatik olarak işlem yapılmasını hemde hatayı sıfırlayabiliyorum fakat bu seferde formül çok uzuyor ve karakter sayısı sorunu çıkıyor karşıma.

k01 ve k02 ve (bunu haricindeki bir çok dosyada) mali sayfasının tümünde ilk veri hücresi 40 tan başlıyor bazı dosya sayfalarında 10 satır veri alınması gerekirken bazısında 20-25 satırlık veri olabiliyor bunu değiştirmem mümkün değil her dosyada yapılan imalatlar aynı da farklı da olabiliyor bu yüzden artış veya azalış olabiliyor imalat cinslerinde
 

manonfire

Altın Üye
Katılım
24 Mayıs 2008
Mesajlar
57
Excel Vers. ve Dili
365 pro tr + 2016 pro plus tr
Altın Üyelik Bitiş Tarihi
29-12-2026
Arkadaşlar derdime bir çare lütfen...
 

manonfire

Altın Üye
Katılım
24 Mayıs 2008
Mesajlar
57
Excel Vers. ve Dili
365 pro tr + 2016 pro plus tr
Altın Üyelik Bitiş Tarihi
29-12-2026
Günaydın soruma bir göz atıp cevaplarsanız çok sevinirim
 
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Ana dosyanızda gereksiz birleştirilmiş iki kolon vardı. Kaldırıldı.

Rapor hazırla.xlsm dosyası diğer dosyaların bulunduğu klasörde olmalı.

Program kısaca, bulunduğu klasör ve onun altındaki tüm klasörlerde dosya adlarında "KESİN ATAŞMAN K" buluklarınının verilerini bileştirir ve ana dosyaya kopyalar.

Veri dosyalarında satır başlangıç ve bitiş bağımsızdır. SIRA NO nun bulunduğu satırı başlangıç kabul eder.

Bu dosya isimleri değiştirilmemelidir.

İNÖNÜ POZLARI.xlsx
İNÖNÜ ATAŞMAN KESİN HESAP MALİ TOPLAM.xlsx

Kod:
Dim aradizin, dosya, yenidosya, veridosya, anadosya, pozdosya As String

Sub menu()
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
   aradizin = ActiveWorkbook.Path
   Call yenidosya_ac
   Call dosyalari_bul
   Call toplamlari_bul
   Call anadosya_ac
   Call poz_kopyala
   Call son_duzenleme
   Call dosya_kaydet
   MsgBox ("İşlem Tamamlandı.")
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Sub dosya_kaydet()
    Workbooks(yenidosya).Close savechanges:=False
    Workbooks(anadosya).Activate
    'Workbooks(anadosya).Save
    'Workbooks(anadosya).Close savechanges:=False
End Sub

Sub son_duzenleme()
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "ATAŞMAN TOPLAMI"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D" & sonsatir)
    Range("D2:D" & sonsatir).Select
    Range("F2").Select
    sayfaadi = ActiveSheet.Name
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4]," & sayfaadi & "!C[-5]:C[-4],2,0)"
    Selection.AutoFill Destination:=Range("F2:F" & sonsatir)
    Range("F2:F" & sonsatir).Select
    Columns("F:F").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F5").Select
    Application.CutCopyMode = False
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
    Range("H2").Select
    Selection.AutoFill Destination:=Range("H2:H" & sonsatir)
    Range("H2:H" & sonsatir).Select
    Columns("H:H").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H2").Select
    Application.CutCopyMode = False
   
    Dim Rky As Range
    For Each Rky In Range("F2:H" & sonsatir)
        If IsError(Rky.Value) Then
            Rky.Value = 0
        End If
    Next Rky
    Set Rky = Nothing
    
    Range("A2:H2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("İNÖNÜ ATAŞMAN KESİN HESAP MALİ TOPLAM.xlsx").Activate
    
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    Set k = Range("A1:A" & sonsatir).Find("SIRA NO", , xlValues, xlWhole)
    satir = 0
    If k Is Nothing Then
    Else
     satir = k.Row + 1
    End If
    
    Range("A" & satir).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C49").Select
End Sub

Sub poz_kopyala()

    Workbooks.Open Filename:=aradizin & "\İNÖNÜ POZLARI.xlsx", UpdateLinks:=0
    pozdosya = ActiveWorkbook.Name
    Sheets(1).Select
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    Set k = Range("A1:A" & sonsatir).Find("SIRA NO", , xlValues, xlWhole)
    satir = 0
    If k Is Nothing Then
    Else
     satir = k.Row + 1
    End If
      
    Range("A" & satir & ":I" & sonsatir).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(yenidosya).Activate
    Sheets.Add
    sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
    Range("A" & sonsatir).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("D:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Workbooks(pozdosya).Close
End Sub

Sub anadosya_ac()
    Workbooks.Open Filename:=aradizin & "\İNÖNÜ ATAŞMAN KESİN HESAP MALİ TOPLAM.xlsx", UpdateLinks:=0
    anadosya = ActiveWorkbook.Name
    Sheets(1).Select
    sonsatir = Cells(Rows.Count, "A").End(3).Row + 2
    Set k = Range("A1:A" & sonsatir).Find("SIRA NO", , xlValues, xlWhole)
    satir = 0
    If k Is Nothing Then
    Else
     satir = k.Row + 1
    End If
    Rows(satir & ":" & sonsatir).Delete
End Sub

Sub toplamlari_bul()
    Columns("C:G").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Kod"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Miktar"
    
    sayfaadi = ActiveSheet.Name
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    
    Columns("A:B").Select
    ActiveWorkbook.Worksheets(sayfaadi).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(sayfaadi).Sort.SortFields.Add Key:=Range("A2:A" & sonsatir) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(sayfaadi).Sort
        .SetRange Range("A1:B" & sonsatir)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A2").Select
    
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    
    Columns("A:B").Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        sayfaadi & "!R1C1:R" & sonsatir & "C2", Version:=6).CreatePivotTable TableDestination:= _
        sayfaadi & "!R1C5", TableName:="PivotTable1", DefaultVersion:=6
    Sheets(sayfaadi).Select
    Cells(1, 5).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Kod")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Miktar"), "Say Miktar", xlCount
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Say Miktar")
        .Caption = "Toplam Miktar"
        .Function = xlSum
    End With
    Columns("E:F").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:D").Select
    Range("D1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Kod"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Miktar"
    Range("B2").Select
End Sub


Sub yenidosya_ac()
    Workbooks.Add
    yenidosya = ActiveWorkbook.Name
    
End Sub

Sub dosyalari_bul()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim Folder As Scripting.Folder, Subfolder As Scripting.Folder, File As Scripting.File
    Dim wb As Workbook
    Set Fso = CreateObject("Scripting.FileSystemObject")

    Set Folder = Fso.GetFolder(aradizin)
    i = 0
    If Folder.SubFolders.Count > 0 Then
      For Each Subfolder In Folder.SubFolders
        For Each File In Subfolder.Files
            i = i + 1
            Cells(i, 1).Value = File.Name
            If InStr(File.Name, ".xls") > 0 And InStr(File.Name, "KESİN ATAŞMAN K") > 0 Then
               dosya = File
               Call sayfa_kopyala
            End If
        Next
      Next
    End If
     
    For Each File In Folder.Files
     If InStr(File.Name, ".xls") > 0 And InStr(File.Name, "KESİN ATAŞMAN K") > 0 Then
         dosya = File
         Call sayfa_kopyala
      End If
    Next
    Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub sayfa_kopyala()
    Range("F9").Select
    Workbooks.Open Filename:=dosya, UpdateLinks:=0
    veridosya = ActiveWorkbook.Name
    Sheets(1).Select
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    Set k = Range("A1:A" & sonsatir).Find("SIRA NO", , xlValues, xlWhole)
    satir = 0
    If k Is Nothing Then
    Else
     satir = k.Row + 1
    End If
      
    Range("A" & satir & ":H" & sonsatir).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(yenidosya).Activate
    sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
    Range("A" & sonsatir).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Workbooks(veridosya).Close
End Sub
 

Ekli dosyalar

Son düzenleme:

manonfire

Altın Üye
Katılım
24 Mayıs 2008
Mesajlar
57
Excel Vers. ve Dili
365 pro tr + 2016 pro plus tr
Altın Üyelik Bitiş Tarihi
29-12-2026
öncelikle cevapladığınız için teşekkür ederim mesajınızı okudum yazdığınız kodu kullanmadım henüz rapor hazırla diye bir doya daha koymuşsunuz bu tamamen ayrı bir dosya mı eğer öyleyse benim istediğim (inönü ataşman kesin hesap mali toplam) dosyasında inönü kesin ataşman k01 ve bunun gibi birçok dosyadan toplam verileri alıp bu dosyaların genel toplamını göstermesidir.
Bir sorum daha olacak istediğimi işlevlerle yapmak mümkün değil mi makro zorunlu mudur
 
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
öncelikle cevapladığınız için teşekkür ederim mesajınızı okudum yazdığınız kodu kullanmadım henüz rapor hazırla diye bir doya daha koymuşsunuz bu tamamen ayrı bir dosya mı eğer öyleyse benim istediğim (inönü ataşman kesin hesap mali toplam) dosyasında inönü kesin ataşman k01 ve bunun gibi birçok dosyadan toplam verileri alıp bu dosyaların genel toplamını göstermesidir.
Bir sorum daha olacak istediğimi işlevlerle yapmak mümkün değil mi makro zorunlu mudur
Önce programı inceleyin, sonucunu görün. Daha sonra konuşalım :)

Makrosuz yapılamaz diyemem. Ancak dosyalarınızın fazla olması ve tam bir düzen içinde olmaması makrosuz yapılması için problem oluşturuyor.
 

manonfire

Altın Üye
Katılım
24 Mayıs 2008
Mesajlar
57
Excel Vers. ve Dili
365 pro tr + 2016 pro plus tr
Altın Üyelik Bitiş Tarihi
29-12-2026
Uzun zamandır bu sorunuma bakan arkadaşlardan sonra cevaplayan nadir insanlardan biri olduğunuzdan dolayı teşekkür ederim.fakat her iki dosyayı da açıp rapor hazırla dediğimde çıkan resimde görüldüğü gibi. Bir de sorunlardan biri de şu bu dosyaları ben hazırlıyorum ama başka bilgisayarlarda başka kişilerde verileri görmek için kullanıyor bundan dolayı diğerlerinde makro çalıştırıyor olması gerekiyor makro çalıştırması kısıtlı olan kullanıcılarda var ne yazık ki...
 

Ekli dosyalar

  • 495.1 KB Görüntüleme: 6
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Uzun zamandır bu sorunuma bakan arkadaşlardan sonra cevaplayan nadir insanlardan biri olduğunuzdan dolayı teşekkür ederim.fakat her iki dosyayı da açıp rapor hazırla dediğimde çıkan resimde görüldüğü gibi. Bir de sorunlardan biri de şu bu dosyaları ben hazırlıyorum ama başka bilgisayarlarda başka kişilerde verileri görmek için kullanıyor bundan dolayı diğerlerinde makro çalıştırıyor olması gerekiyor makro çalıştırması kısıtlı olan kullanıcılarda var ne yazık ki...
Kod ve dosya güncellendi.

Ekli ZIP lı dosyayı farklı bir klasöre açın. Rapor hazırla.xlsm dosyasını açın butona basın. Bu program çalışırken diğer tüm excel dosyalarınızı kapatın.

Program Kxx dosyalarını ana dosyada birleştirecektir.

Daha sonra sizdeki diğer Kxx dosyaları bu klasöre kopyalayıp Rapor hazırla programını çalıştırın. Ana dosya birleştirilmiş olarak ekranda açık kalacaktır. Sizin ayrıca kaydetmeniz gerekecek.

Program diğer dosyalara müdahale etmiyor o dosyalarda makro çalışmıyor. Bunun ürettiği sonucu diğer kullanıcılarda görebilir.


İNÖNÜ ATAŞMAN KESİN HESAP MALİ TOPLAM.xlsx dosyası olarak sadece bu ZIP dosyasındakini kullanabilirsiniz. Program bu formata göre ayarlandı.
 

manonfire

Altın Üye
Katılım
24 Mayıs 2008
Mesajlar
57
Excel Vers. ve Dili
365 pro tr + 2016 pro plus tr
Altın Üyelik Bitiş Tarihi
29-12-2026
Dosyanızı inceledim toplamlardan aldığı veriler ve genel toplam verileri doğru çok güzel bir çalışma ... Fakat bir önceki mesajımda da söylediğim gibi bir sorunum var bunun nasıl üstesinden gelinebilir.
 

manonfire

Altın Üye
Katılım
24 Mayıs 2008
Mesajlar
57
Excel Vers. ve Dili
365 pro tr + 2016 pro plus tr
Altın Üyelik Bitiş Tarihi
29-12-2026
Aynen dediğiniz gibi 151 adet dosyamı da klasörün içine kopyalayıp çalıştırdım hepsini hesapladı (son satırda her iki sütunda da başvuru hatası verdi) resimdeki pencere yine çıkıyor end ile sonlandırıyorum ayrıca hesapların tümünü aktaracağı ana dosya resim dede görüldüğü gibi "sıfır" olarak görünüyor toplamları aktarmıyor. Bu arada makro çalıştıramayacak bir çok bilgisayar ben de bu yüzden cebelleşiyorum fonksiyonlarla . Hoş makro yazmayı da bilmiyorum zaten siz böyle güzel bir çalışma yapınca insan özeniyor doğrusu.
 

Ekli dosyalar

  • 497.4 KB Görüntüleme: 3

manonfire

Altın Üye
Katılım
24 Mayıs 2008
Mesajlar
57
Excel Vers. ve Dili
365 pro tr + 2016 pro plus tr
Altın Üyelik Bitiş Tarihi
29-12-2026
kod ve dosya güncellendi.

Ekli zıp lı dosyayı farklı bir klasöre açın. Rapor hazırla.xlsm dosyasını açın butona basın. bu program çalışırken diğer tüm excel dosyalarınızı kapatın.

program kxx dosyalarını ana dosyada birleştirecektir.

Daha sonra sizdeki diğer kxx dosyaları bu klasöre kopyalayıp rapor hazırla programını çalıştırın. Ana dosya birleştirilmiş olarak ekranda açık kalacaktır. Sizin ayrıca kaydetmeniz gerekecek.

program diğer dosyalara müdahale etmiyor o dosyalarda makro çalışmıyor. Bunun ürettiği sonucu diğer kullanıcılarda görebilir.


[ı]inönü ataşman kesin hesap mali toplam.xlsx dosyası olarak sadece bu zıp dosyasındakini kullanabilirsiniz. Program bu formata göre ayarlandı.[/ı]
sizin ayrıca kaydetmeniz gerekli dediğinizi anlamadım açıklar mısınız
 
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Aynen dediğiniz gibi 151 adet dosyamı da klasörün içine kopyalayıp çalıştırdım hepsini hesapladı (son satırda her iki sütunda da başvuru hatası verdi) resimdeki pencere yine çıkıyor end ile sonlandırıyorum ayrıca hesapların tümünü aktaracağı ana dosya resim dede görüldüğü gibi "sıfır" olarak görünüyor toplamları aktarmıyor. Bu arada makro çalıştıramayacak bir çok bilgisayar ben de bu yüzden cebelleşiyorum fonksiyonlarla . Hoş makro yazmayı da bilmiyorum zaten siz böyle güzel bir çalışma yapınca insan özeniyor doğrusu.
Sayfa1 oluşmuş, sayfa2 oluşmamız yani poz dosyası ile ilgili bir sorun olabilir.

Bize gönderdiğiniz örnek dosyalar ile şu anda uyguladığınız örnek dosyalar arasında bir uyumsuzluk var sanırım.

Benim ZIP lı dosyamı açıp hiç bir ekleme yapmadan raporu çalışıtırır mısınız?

Bir sorun çıkacak mı bakalım.
 

manonfire

Altın Üye
Katılım
24 Mayıs 2008
Mesajlar
57
Excel Vers. ve Dili
365 pro tr + 2016 pro plus tr
Altın Üyelik Bitiş Tarihi
29-12-2026
sadece sizin gönderdiğiniz dosya birleştirme klasörünü açıp ilk önce tüm excel dosyaları kapalı iken rapor hazırla ve çalıştır dedim bunda aynı hata penceresi var fakat başv hatası yok sonra kesin hesap açtım . kesin hesapta bir değişiklik yok hepsi sıfır hala ( bu arada 151 dosyayla çalıştırdığımda başv hatası çıkmıştı tüm dosya isimleri doğru dosya içindeki hücree verilerinde birşey olabilir belki )
 
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
sadece sizin gönderdiğiniz dosya birleştirme klasörünü açıp ilk önce tüm excel dosyaları kapalı iken rapor hazırla ve çalıştır dedim bunda aynı hata penceresi var fakat başv hatası yok sonra kesin hesap açtım . kesin hesapta bir değişiklik yok hepsi sıfır hala ( bu arada 151 dosyayla çalıştırdığımda başv hatası çıkmıştı tüm dosya isimleri doğru dosya içindeki hücree verilerinde birşey olabilir belki )

Bende gönderdiğim dosyalar sorunsuz çalışıyor.

Bu şekilde bir sonuç alamayacağız.

Özel değil ise dosyalarınızı tek paket yapıp asriakdeniz@gmail.com a gönderir misiniz?
 
Üst