Makro ile etopla gibi listeleme

[melihseber]

Arkadaşlar merhaba,
Ekli dosyada hesap sayfasındaki listele tuşuna bastığımda tablo sayfasındaki parça kodu ve toplam adetleri etopla gibi süzecek bir makro yapabilirmiyiz, makro üzerinde değişiklikler yapmak için etopla fonksiyonunu kullanmak istemiyorum.
yardım ederseniz sevinirim, iyi çalışmalar.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Private Sub Hesap_Click()
On Error Resume Next
Set s1 = Sheets("tablo")
For a = 4 To s1.[b65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("b4:b" & a), s1.Cells(a, "b")) = 1 Then
c = c + 1
Cells(c + 16, "b") = s1.Cells(a, "b")
Cells(c + 16, "c") = WorksheetFunction.SumIf(s1.[b:b], s1.Cells(a, "b"), s1.[d:d])
End If
Next
End Sub

 

[melihseber]

Elinize sağlık, uyguladım ve süper çalışıyor,
fakat bu toplam adet kısmında boş çıkan satırları hiç listeye almasa,
aslında etopla kullanmamamın bir nedenide o satırlardan kurtulmaktı.
çünkü çok sayıda boş satırım ve az sayıda dolu sütunum çıkacak sonuçlarda.
yardımınız için çok teşekkürler

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Private Sub Hesap_Click()
On Error Resume Next
Set s1 = Sheets("tablo")
For a = 4 To s1.[b65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("b4:b" & a), s1.Cells(a, "b")) = 1 Then
If IsError(WorksheetFunction.SumIf(s1.[b:b], s1.Cells(a, "b"), s1.[d:d])) = True Then GoTo 10
c = c + 1
Cells(c + 16, "b") = s1.Cells(a, "b")
Cells(c + 16, "c") = WorksheetFunction.SumIf(s1.[b:b], s1.Cells(a, "b"), s1.[d:d])
End If
10 Next
End Sub

 

[melihseber]

Sayın leventm, harikasınız valla
sanki bir yerden kopyalayıp foruma yapıştırıyor gibisiniz.
çok teşekkürler, inanın çook işime yarayacak