combobox mükerrer kayıt

Katılım
15 Ocak 2013
Mesajlar
85
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
24/05/2022
Set s = Sheets("Urunler")
For i = 2 To s.Range("b65536").End(3).Row
If WorksheetFunction.CountIf(s.Range("b2:b" & i), s.Cells(i, "b")) = 1 Then
modelCombo.AddItem s.Cells(i, "b").Value
End If
Next

Arkadaşlar yukarıdaki kod ile mükerrer kayıtları kaldırarak verileri teke indirebiliyorum
alttaki blokta nasıl bir uyarlama yapmam lazım ki modelCombo daki değere göre urunlerdeki mükerrer kayıtları da teke indirebileyim

Set s = Sheets("Urunler")
urunCombo.Clear
For X = 2 To s.Range("b65536").End(3).Row
If s.Cells(X, 2).Value = modelCombo.Value Then
' If WorksheetFunction.CountIf(s.Range("c2:c" & i), s.Cells(i, "c")) = 1 Then
urunCombo.AddItem s.Cells(X, 3).Value
End If
Next
urunCombo.ListIndex = 0
End Sub
 

AdemCan

Altın Üye
Destek Ekibi
Katılım
1 Eylül 2008
Mesajlar
1,386
Excel Vers. ve Dili
2019 TR
Çokeğersay kullanarak kodu güncelledim.
Kod:
Private Sub modelCombo_Change()
Set s = Sheets("Urunler")
urunCombo.Clear
    For i = 2 To s.Range("b65536").End(3).Row
        If s.Cells(i, 2).Value = modelCombo.Value Then
            If WorksheetFunction.CountIfs(s.Range("b2:b" & i), s.Cells(i, "b"), s.Range("c2:c" & i), s.Cells(i, "c")) = 1 Then
                urunCombo.AddItem s.Cells(i, 3).Value
            End If
        End If
    Next
urunCombo.ListIndex = 0
End Sub
 
Katılım
15 Ocak 2013
Mesajlar
85
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
24/05/2022
AdemCan üstadım elinize emeğinize sağlık çok teşekkürler
 

AdemCan

Altın Üye
Destek Ekibi
Katılım
1 Eylül 2008
Mesajlar
1,386
Excel Vers. ve Dili
2019 TR
Rica ederim.
 
Üst