Birden Fazla Dosya Mevcut ve Dosyaların içerisinde Birden Fazla Sayfa Mevcut

Katılım
2 Aralık 2022
Mesajlar
13
Excel Vers. ve Dili
Microsoft Office 365
Elimde 9 adet excel dosyası mevcut ve bu dosyaların içerisinde 30 ar adet sayfa var fakat şöyle bir sorunum var. sayfaların içerisinde il isimleri var ve yanlarında sayılar mevcut her sayfada ve dosyada il isimlerinin sıraları farklı farklı yerlerde. bu dosyaların içerisindeki sayıları tek bir yerde toplamak istiyorum
örnek olarak;
1. dosyada ankara a6 da b6 da 1578 yazıyor.
2. dosyada ankara b9 da c9 da 1542 yazıyor.
..
.....
.....
10. dosyada ankarayı a1 de yazdırıp b1 de diğer dosyalardaki sayılarını toplatmak istiyorum.
 

tugkan

Altın Üye
Katılım
6 Kasım 2004
Mesajlar
314
Excel Vers. ve Dili
Excel 2016
Türkçe 64 BIT
Altın Üyelik Bitiş Tarihi
16-10-2025
Deneyip sonucu paylaşır mısınız?
Excel dosyalarındaki il isimlerini ve yanındaki sayıları toplamak için VBA makrosu kullanabilirsiniz. Aşağıda, her dosyadaki il isimlerini ve sayıları toplayan bir makro örneği bulunmaktadır. Bu makro, il isimlerini ve sayıları belirttiğiniz hücrelere yazdıracaktır.

VBA Makrosu Örneği
  1. Excel Dosyalarını Hazırlama: Öncelikle, toplamak istediğiniz Excel dosyalarının bulunduğu klasörü belirleyin.
  2. Makroyu Ekleme:
    • Excel'de ALT + F11 tuşlarına basarak VBA editörüne gidin.
    • Insert menüsünden Module seçeneğini seçin.
    • Aşağıdaki kodu yeni modüle yapıştırın:
Kod:
Sub ToplaIlSayilari()
    Dim dosyaYolu As String
    Dim dosyaAdi As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim ilSayi As Object
    Dim il As String
    Dim i As Long, j As Long
    Dim sonSatir As Long
    Dim ilSayiToplam As Long
    
    ' İllere ve sayılarına göre bir sözlük oluştur
    Set ilSayi = CreateObject("Scripting.Dictionary")
    
    ' Dosyaların bulunduğu yol (Klasör yolu)
    dosyaYolu = "C:\DosyaYolu\" ' Kendi klasör yolunuza göre düzenleyin
    
    ' Klasördeki her bir Excel dosyasını açın
    dosyaAdi = Dir(dosyaYolu & "*.xls*")
    Do While dosyaAdi <> ""
        Set wb = Workbooks.Open(dosyaYolu & dosyaAdi)
        
        ' Her bir çalışma sayfasında döngü
        For Each ws In wb.Worksheets
            sonSatir = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' A sütunundaki son satırı bul
            
            For i = 1 To sonSatir
                il = ws.Cells(i, 1).Value ' A sütununda il ismi
                If IsNumeric(ws.Cells(i, 2).Value) Then
                    ' Eğer sözlükte yoksa, ekle
                    If Not ilSayi.Exists(il) Then
                        ilSayi(il) = 0
                    End If
                    ' Sayıyı ekle
                    ilSayi(il) = ilSayi(il) + ws.Cells(i, 2).Value ' B sütunundaki sayıyı toplar
                End If
            Next i
        Next ws
        
        wb.Close False ' Dosyayı kaydetmeden kapat
        dosyaAdi = Dir ' Sonraki dosyayı al
    Loop

    ' Sonuçları yazdır
    Dim sonucSayfasi As Worksheet
    Set sonucSayfasi = ThisWorkbook.Worksheets.Add ' Yeni bir sayfa oluştur
    
    ' Başlıkları yaz
    sonucSayfasi.Cells(1, 1).Value = "İl"
    sonucSayfasi.Cells(1, 2).Value = "Toplam"
    
    ' Sonuçları yaz
    i = 2
    For Each il In ilSayi.Keys
        sonucSayfasi.Cells(i, 1).Value = il
        sonucSayfasi.Cells(i, 2).Value = ilSayi(il)
        i = i + 1
    Next il

    MsgBox "İl sayıları toplandı!"
End Sub
Kullanım Talimatları
  1. dosyaYolu değişkenini, Excel dosyalarınızın bulunduğu klasörün yolu ile değiştirin (örneğin, C:\DosyaYolu\).
  2. VBA penceresinde F5 tuşuna basarak makroyu çalıştırın.
  3. Makro, belirtilen klasördeki tüm Excel dosyalarını açacak, il isimlerini ve yanındaki sayıları toplayacak ve sonuçları yeni bir sayfada yazdıracaktır.
Bu makro, A sütununda il isimleri ve B sütununda sayılar bulunan dosyalar için çalışır. Eğer il isimleri farklı sütunlarda ise, kodda gerekli düzenlemeleri yapmanız gerekebilir.
 
Üst