toplam aldırma

beconzi

Altın Üye
Katılım
1 Temmuz 2013
Mesajlar
12
Excel Vers. ve Dili
ofis 365 türkçe
Öncelikle herkese sağlıklı bir gün dilerim.
Eklediğim tabloda farklı sayfalardaki farklı adlara ait miktar toplamlarını toplam sayfasına nasıl aldırabilirim.
Ayrıca sayfalardaki isimleri toplam sayfasına getirmek mümkün olabilir mi?
Yardımlarınız için teşekkür ederim.
 

Ekli dosyalar

istediğiniz bu şekilde mi
 

Ekli dosyalar

İlginize teşekkür ederim.
Ancak sayfa sayısı çok fazla olduğunda daha pratik bir çözüm bulunabilir mi?
 
Merhaba,
Excel dosyasını kullanırken aşağıdaki yöntemi uygulamanız yeterli olacaktır.
Amaç:
Çalışma kitabındaki farklı sayfalarda yer alan “adı” ve “miktar” verilerini tek bir toplam görünümde birleştirmek.
Nasıl çalışır?
  1. Her kaynak sayfa aynı yapıda olmalıdır:
    • sütun A: adı
    • sütun B: miktar
  2. Yeni sayfa ekleyeceğinizde, bu sayfanın adı Ayarlar sayfasındaki listeye eklenmelidir.
  3. Ardından BirleşikVeri tablosu güncellenmeli ve Özet sayfası otomatik olarak yeni toplamları göstermelidir.
Örnek senaryo
  • 500 sayfa varsa da aynı mantık uygulanır.
  • Her sayfada veri varsa, sistem onları tek bir birleşik tabloya taşır.
  • Sonuçlar Özet sayfasında görülebilir.
Önemli Not
  • Bu dosya, tek tek sayfaları manuel olarak toplamaya göre daha pratik ve daha hızlı bir yapı sunar.
  • Eğer sayfa sayısı çok artarsa, analiz sürecini daha da kolaylaştırmak için ileride Power Query veya otomatik birleştirme yöntemi eklenebilir.
 

Ekli dosyalar

Üzerinde çalışayım, takıldığım konu olursa rahatsız ederim.
Teşekkürler.
 
Bu şekilde bir deneyin!
Not : Çoklu bağlantılı sayfalarda formüllü çözümler işlevsiz kalabilir, bunun can simidi VBA kod çözümleridir!
Kod:
Sub VerileriTopla()
Dim dict As Object
Dim ws As Worksheet, wsToplam As Worksheet
Dim sonSatir As Long, i As Long
Dim veriDizisi As Variant, ciktiDizisi As Variant
Dim anahtar As Variant
Dim satir As Long
Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare '
On Error Resume Next
Set wsToplam = ThisWorkbook.Sheets("Toplam")
On Error GoTo 0
If wsToplam Is Nothing Then
MsgBox "'Toplam' adında bir sayfa bulunamadı. Lütfen sayfa adını kontrol edin", vbCritical
Exit Sub
End If
wsToplam.Range("A2:B" & wsToplam.Rows.Count).ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Toplam" Then
sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If sonSatir > 1 Then
veriDizisi = ws.Range("A2:B" & sonSatir).Value
For i = 1 To UBound(veriDizisi, 1)
If Not IsEmpty(veriDizisi(i, 1)) Then
If dict.Exists(veriDizisi(i, 1)) Then
dict(veriDizisi(i, 1)) = dict(veriDizisi(i, 1)) + veriDizisi(i, 2)
Else
dict.Add veriDizisi(i, 1), veriDizisi(i, 2)
End If
End If
Next i
End If
End If
Next ws
If dict.Count > 0 Then
ReDim ciktiDizisi(1 To dict.Count, 1 To 2)
satir = 1
For Each anahtar In dict.keys
ciktiDizisi(satir, 1) = anahtar
ciktiDizisi(satir, 2) = dict(anahtar)
satir = satir + 1
Next anahtar
wsToplam.Range("A2").Resize(dict.Count, 2).Value = ciktiDizisi
MsgBox "Veriler başarıyla derlendi ve toplandı!", vbInformation
Else
MsgBox "Toplanacak veri bulunamadı", vbExclamation
End If
End Sub
 

Ekli dosyalar

Son düzenleme:
Emeğinize sağlık teşekkürler,
 
Geri
Üst