Vba ile Rapor alma

Katılım
14 Ocak 2005
Mesajlar
792
Excel Vers. ve Dili
Ofis 2010 2016
Altın Üyelik Bitiş Tarihi
13/03/2022
Selam Arkadaşlar, Sizlerin yardımıyla kendime çok güzel bir irsaliye takip programı yaptım bir firma ile başımız dertte günlük gelen ürünleri hep sorunlu ya geliyor ya gelmiyor fazla fatura ediyorlar vb.. Bunların önünüe geçebilmek için bende kendime işte sizlerinde yardımıyla bir takip sistemi kurdum.

Ama burda da rapor alırken yine vb ya ihtiyacım Bu konuda da yardımlarınızı esirgemiyeceğinizi umuyorum.

Veri sayfasındaki verilerim üzerinde B sutunu tarih D sutunu Mlz_Kod G sutunu Miktar J sutunu Toplam Tutar L sutunu Kdv Tutarı ve M sutunu Kdvli Toplam dır.

Benim yapmak istediğim Macro ile B sutunundaki benim girdiğim tarih aralığında verileri bulup D sutunundaki mlz_kod ları ilk girişten yazarak benzeri varsa ona ilave ederek Diyelim ki 01/08/2007 ile 07/08/2007 tarihleri arasında M OE 3045 ÜRÜNÜ RAPOR SAYFASINA YAZSIN A1 E YAZSIN B1 E mlz_adi C1 MİTARI D1 E TOPLAM TUTAR E1 İSK.TUTAR F1 E KEV TUTARI G1 E KDVLİ TOPLAM yazsın ve aşağı doğru yine M OE 3045 ÜRÜNÜ VARSA BUNLARIN ÜZERİNE TOPLAYARAK YAZSIN DİĞERLERİ DE AYNI MANTIKLA ALT ALTA DEVAM ETSİN
Bunu yapmak sanırım mümkün ama ben nasıl yapacağımı bilemiyorum. Yardım ederseniz çok sevenirim.
örnek dosyamı da ekliyorum.
 
Son düzenleme:
Katılım
14 Şubat 2006
Mesajlar
3,426
Excel Vers. ve Dili
(Excel 2016 - İngilizce)
Altın Üyelik Bitiş Tarihi
30-11-2022
Rapor sayfasına birkaç malzeme kodu için olmasını istediğiniz sonuçları yazabilirmisiniz?
 
Katılım
14 Ocak 2005
Mesajlar
792
Excel Vers. ve Dili
Ofis 2010 2016
Altın Üyelik Bitiş Tarihi
13/03/2022
Sayın Ripek istediğiniz gibi örnek dosyayı benim istediğim gibi düzenleyerek ekledim.
 
Katılım
14 Şubat 2006
Mesajlar
3,426
Excel Vers. ve Dili
(Excel 2016 - İngilizce)
Altın Üyelik Bitiş Tarihi
30-11-2022
Aşağıdaki kodları kullanabilirsiniz.

Kod:
Sub AktarTopla()
Dim a, i As Long, b(), n As Long
Set s1 = Sheets("veri")
Set s2 = Sheets("rapor")
With s1.Range("a2:m" & s1.[a65536].End(3).Row).Resize(, 13) 'veri sayfasındaki a2 ile a kolonundaki son satırdan sağdaki 13 kolonu
     a = .Value ' a değişkenine atanıyor.
     ReDim b(1 To UBound(a, 1), 1 To 8) 
End With
With CreateObject("Scripting.Dictionary") 'Dictionary nesnesi oluşturuluyor.
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
        If CDate(a(i, 2)) >= CDate([K2]) And CDate(a(i, 2)) <= CDate([L2]) Then ' a değişkenindeki 2.kolonun tarihi belirttiğiz tarih aralığında ise
            If Not .exists(a(i, 4)) Then ' ve a değişkenindeki 4. kolon malzeme kodu yok ise, yani teke düşürüyoruz.
                n = n + 1
                b(n, 1) = n  ' Dizinin 1.elemanına Sıra No
                b(n, 2) = a(i, 4) 'Dizinin 2.elemanına Malzeme Kodu
                .Add a(i, 4), n 'Dictionary nesnesine kontrol için Malzeme No 
                b(n, 3) = a(i, 5) 'Dizinin 3 elemanına Malzeme Adı
            End If
                b(.Item(a(i, 4)), 4) = b(.Item(a(i, 4)), 4) + a(i, 7) 'malzeme kodu var ise l ise 
                b(.Item(a(i, 4)), 5) = b(.Item(a(i, 4)), 5) + a(i, 10) ' diğer alanların toplamını alıyoruz.
                b(.Item(a(i, 4)), 6) = b(.Item(a(i, 4)), 6) + a(i, 11) '....
                b(.Item(a(i, 4)), 7) = b(.Item(a(i, 4)), 7) + a(i, 12)
                b(.Item(a(i, 4)), 8) = b(.Item(a(i, 4)), 8) + a(i, 13)
        End If
     Next
End With
s2.Range("a2:m" & s2.[a65536].End(3).Row).Resize(, 8).ClearContents
s2.[a2].Resize(n, 8).Value = b
MsgBox "Bitti"
s2.Select
[a1].Select
Set s1 = Nothing
Set s2 = Nothing
End Sub
 
Son düzenleme:
Katılım
14 Ocak 2005
Mesajlar
792
Excel Vers. ve Dili
Ofis 2010 2016
Altın Üyelik Bitiş Tarihi
13/03/2022
Say&#305;n ripek &#199;ok &#199;ok te&#351;ekk&#252;r ederim. Tam istedi&#287;im gibi olmu&#351;. Bu hem i&#351;imi g&#246;rd&#252; hemde di&#287;er &#231;al&#305;&#351;malar&#305;m i&#231;in &#246;rnek te&#351;kil edecek. Sizden Allah raz&#305; olsun. Bu arada B&#252;t&#252;n arkada&#351;lar&#305;n Kandilleri M&#252;barek olsun.
 
Katılım
14 Ocak 2005
Mesajlar
792
Excel Vers. ve Dili
Ofis 2010 2016
Altın Üyelik Bitiş Tarihi
13/03/2022
Say&#305;n Ripek Daha sonraki &#231;al&#305;&#351;malar&#305;m&#305;za daha iyi anlayarak &#246;rnek te&#351;kil etmesi i&#231;in k&#305;sa a&#231;&#305;klamalar yazabilirseniz benim anlamam daha kolay olacak. Ezbere yapmam&#305;&#351; oluruz. Zaman&#305;n&#305;z varsa tabi. Te&#351;ekk&#252;rler.
 
Katılım
14 Şubat 2006
Mesajlar
3,426
Excel Vers. ve Dili
(Excel 2016 - İngilizce)
Altın Üyelik Bitiş Tarihi
30-11-2022
A&#231;&#305;klama bilgileri yanlar&#305;na eklenmi&#351;tir.
 
Katılım
14 Ocak 2005
Mesajlar
792
Excel Vers. ve Dili
Ofis 2010 2016
Altın Üyelik Bitiş Tarihi
13/03/2022
Say&#305;n Ripek &#231;ok te&#351;ekk&#252;r ederim. Elinize sa&#287;l&#305;k
 
Üst