Verileri 3 Koşula Göre Gruplayıp ListView'e Alma

[programer]

Arkadaşlar herkese iyi geceler.

Sub listele()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
For a = 2 To s1.[b65536].End(3).Row
If s1.Cells(a - 1, "b") & s1.Cells(a - 1, "c") <> s1.Cells(a, "b") & s1.Cells(a, "c") Then
c = c + 1
For b = 2 To 7
s2.Cells(c + 1, b - 1) = s1.Cells(a, b)
Next
End If
Next
End Sub

Yukarıdaki kodu kullanarak verileri 2 koşula göre gruplayıp sayfa2'ye alabiliyorum.
Yapmış olduğum Satis Çikiş Formunda bul deyip koşulları seçtikten sonra BUL butonuna tıkladığım zaman verileri ListView'e alıyorum. Ama tekrar eden aynı kayıtlar var. Bu tekrar eden kayıtları Belge No1, Belge No2 ve Fiş Türü Satis_Cikis_Fisi olanları gruplamak istiyorum.

 

[programer]

Arkadaşlar kodu aşağıdaki gibi değiştirdim ama bu seferde Next Komutunda hata verdi

Private Sub CommandButton1_Click()
ListView1.ListItems.Clear

Set sh = Sheets(TextBox1.Value)
son = sh.Cells(65536, 1).End(xlUp).Row
Select Case Veri.Value
       '######################_Stk_Hrk_####################
       Case "H_Belge_No1": Set Rng = sh.Range("B2:B" & son)
       Case "H_Belge_No2": Set Rng = sh.Range("C2:C" & son)
       Case "H_Belge_Tarihi": Set Rng = sh.Range("D2:D" & son)
       Case "H_Fis_Türü": Set Rng = sh.Range("E2:E" & son)
       Case "H_Firma_Kodu": Set Rng = sh.Range("F2:F" & son)
       Case "H_Ambar_Kodu": Set Rng = sh.Range("G2:G" & son)
       Case "H_İrsaliye_No": Set Rng = sh.Range("H2:H" & son)
       Case "H_İrsaliye_Tarihi": Set Rng = sh.Range("I2:I" & son)
       Case "H_Sip_No1": Set Rng = sh.Range("J2:J" & son)
       Case "H_Sip_No2": Set Rng = sh.Range("K2:K" & son)
       Case "H_Stok_Kodu": Set Rng = sh.Range("L2:L" & son)
       Case "H_G_Miktar": Set Rng = sh.Range("M2:M" & son)
       Case "H_C_Miktar": Set Rng = sh.Range("N2:N" & son)
       
       Case Else: MsgBox "Geçerli bir alan seçin", vbCritical, "HATALI ALAN İSMİ": Set sh = Nothing: Exit Sub

End Select
Select Case Kosul.Value
       Case "Benzer": Set Bul = Rng.Find("*" & Deger.Text & "*")
       Case "İle Başlayan": Set Bul = Rng.Find(Deger.Text & "*")
       Case "İle Biten": Set Bul = Rng.Find("*" & Deger.Text)
       Case "Eşittir": Set Bul = Rng.Find(Deger.Text, MatchCase:=True)
       Case Else: MsgBox "Geçerli bir filtre seçin", vbCritical, "HATALI FİLTRE": Set sh = Nothing: Exit Sub
End Select
        If Not Bul Is Nothing Then
                adres = Bul.Address
             Do
                For a = 2 To sh.[b65536].End(3).Row
                If sh.Cells(a - 1, "b") & sh.Cells(a - 1, "c") <> sh.Cells(a, "b") & sh.Cells(a, "c") Then
                sat = Bul.Row
                With ListView1
                   .ListItems.Add , , sh.Cells(sat, 1)
                    X = X + 1
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 2)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 3)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 4)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 5)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 6)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 8)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 7)
                End With
                Set Bul = Rng.FindNext(Bul)
[COLOR="Red"]Next[/COLOR]
             Loop While Not Bul Is Nothing And Bul.Address <> adres
        End If
Set sh = Nothing
Set Rng = Nothing
Set Bul = Nothing

End Sub

 

[programer]

arkadaşlar herkese hayırlı cumalar bu şekilde bi gruplama yapabilirmiyiz yada alternatif bir cözüm bulabilirmiyiz

 

[programer]

Herkese iyi geceler. Bir kaç gündür araştırıyorum ama bi sonuca varamadım. Yardımcı olabilirmisiniz

 

[programer]

arkadaşlar bu konuda bir fikri olan yokmu

 

[Ayhan Ercan]

Arkadaşlar kodu aşağıdaki gibi değiştirdim ama bu seferde Next Komutunda hata verdi

Next ifadesini End İf satırının bir altına yazıp denermisiniz. Aşağıdaki gibi...

If Not Bul Is Nothing Then
                adres = Bul.Address
             Do
                For a = 2 To sh.[b65536].End(3).Row
                If sh.Cells(a - 1, "b") & sh.Cells(a - 1, "c") <> sh.Cells(a, "b") & sh.Cells(a, "c") Then
                sat = Bul.Row
                With ListView1
                   .ListItems.Add , , sh.Cells(sat, 1)
                    X = X + 1
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 2)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 3)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 4)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 5)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 6)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 8)
                   .ListItems(X).ListSubItems.Add , , sh.Cells(sat, 7)
                End With
                Set Bul = Rng.FindNext(Bul)
             Loop While Not Bul Is Nothing And Bul.Address <> adres
        End If
[COLOR=#ff0000]        Next[/COLOR]

 

[programer]

kardeş dediğin gibi yaptım ama copile error Loop Without Do diye hata veriyor bir türlü cözemedim bende

 

[programer]

Arkadaşlar herkese iyi akşamlar. Konu gerilerde kalmış yaklaşık 10 gündür bende araştırıyorum ama bişey bulamadım ve yapamadım. Bana konuyla ilgili yol gösterirmisiniz istediğim şekilde olmuyorsa veye yapılamıyorsa farklı bir önerisi olan arkadaşımız varmı.