farklı sayfalardan veri toplama

Bahadır

Altın Üye
Altın Üye
Katılım
8 Kasım 2005
Mesajlar
286
Beğeniler
51
Excel Vers. ve Dili
Office 2016 EN
#5
Ezgi hanım merhaba,

Yapmak istediğiniz her sayfayı dolanıp, ilgili sayfadaki veriyi, ilgili tarihe göre Liste sayfasına mı yazdırmak?
 
Katılım
29 Aralık 2018
Mesajlar
72
Beğeniler
23
Excel Vers. ve Dili
excel 2013
#6
evet hocam sayfada örnek hazırlamıştım verdiğim örneklerden ve açıklamalardan yola çıkarak özet ve liste sayfasının oluşmasını rica edecektim
 

Bahadır

Altın Üye
Altın Üye
Katılım
8 Kasım 2005
Mesajlar
286
Beğeniler
51
Excel Vers. ve Dili
Office 2016 EN
#7
O sayfalarda tarih kaydı yok ama, o nasıl tespit edilecek?
 

Bahadır

Altın Üye
Altın Üye
Katılım
8 Kasım 2005
Mesajlar
286
Beğeniler
51
Excel Vers. ve Dili
Office 2016 EN
#9
Pardon ekran sağda kalmış.
Üzerinde çalışayım biraz.
 
Katılım
29 Aralık 2018
Mesajlar
72
Beğeniler
23
Excel Vers. ve Dili
excel 2013
#14
hocam baktım cok güzel çalışıyor yalnız B STUNUNDAN dan başlayabilirmiyiz ve yeni arama yapınca eskisini silebilir mi üstüne yazıyor cunku ayrıca özet kısmınıda halletmenizi arz ederim 😊 yarın sabah bu raporu sunmam gerekiyor sagolun
 
Son düzenleme:
Katılım
18 Nisan 2008
Mesajlar
669
Beğeniler
90
Excel Vers. ve Dili
office2010
#15
güzel çalışıyor yalnız onu n etinin dan başlayabilirmiyiz ne demek isteğinizi anlamadım.
 
Katılım
18 Nisan 2008
Mesajlar
669
Beğeniler
90
Excel Vers. ve Dili
office2010
#20
Özet sayfasında bu kodu tekrar deneyin.

Kod:
Private Sub CommandButton1_Click()
Dim a(), b()
satir = Rows.Count
ReDim b(1 To satir, 1 To 6)
Set dd1 = CreateObject("scripting.dictionary")
        For j = 5 To Worksheets.Count
            Set s1 = Sheets(j)
            son = s1.Cells(Rows.Count, 4).End(3).Row
            If son > 6 Then
                a = s1.Range("D7:N" & son).Value
                For i = 1 To UBound(a)
                    krt = a(i, 1)
                    If dd1.exists(krt) Then
                        sat = dd1(krt)
                    Else
                        dd1(krt) = dd1.Count + 1
                        sat = dd1.Count
                        b(sat, 1) = krt
                    End If
                    For y = 2 To 6
                        b(sat, y) = b(sat, y) + a(i, y + 5)
                    Next y
                Next i
            End If
        Next j
Range("B4:G" & Rows.Count).Clear
If dd1.Count > 0 Then
[B4].Resize(dd1.Count, 6) = b
[B4].Resize(dd1.Count, 6).Borders.Color = vbBlack
End If
End Sub
 
Üst