kriter ekleme

[cihangirkara]

arkadaşlar yardımınıza ihtiyacım var
aşağıdaki süz işlemine bir kriter eklemek istiyorum
şuanda sayfa1 b sütünundaki isimleri tekrarsız şekilde listbox1 e yazıyor
isteğim yine aynı işlemi yapsın ama g sütünu dolu olanları yapsın

Private Sub TextBox1_Change()
Set S1 = Sheets("sayfa1")
With ListBox1
.ColumnCount = 1
.ColumnWidths = "65;"
End With
ListBox1.Clear
For suz = 2 To WorksheetFunction.CountA([sayfa1!b1:b65536])
alan = UCase(Replace(Replace(Sayfa1.Range("b" & suz), "j", "J"), "k", "K"))
veri = UCase(Replace(Replace(TextBox1, "j", "J"), "k", "K"))
If alan Like "*" & veri & "*" Then
If WorksheetFunction.CountIf(S1.Range("b2:b" & suz), S1.Cells(suz, "b")) > 1 Then GoTo 10
ListBox1.AddItem
ListBox1.list(s, 0) = Sayfa1.Range("B" & suz)
s = s + 1
End If
10 Next
If WorksheetFunction.CountIf([liste!b:b], TextBox1) > 0 Then
sat = [liste!b1:b65536].Find(TextBox1).Row
TextBox21 = Format(Sheets("liste").Cells(sat, "d"), "#,##0")
TextBox6 = Sheets("liste").Cells(sat, "e")
TextBox27 = Sheets("liste").Cells(sat, "c")
End If

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Private Sub TextBox1_Change()
Set S1 = Sheets("sayfa1")
With ListBox1
.ColumnCount = 1
.ColumnWidths = "65;"
End With
ListBox1.Clear
For suz = 2 To WorksheetFunction.CountA([sayfa1!b1:b65536])
alan = UCase(Replace(Replace(Sayfa1.Range("b" & suz), "j", "J"), "k", "K"))
veri = UCase(Replace(Replace(TextBox1, "j", "J"), "k", "K"))
If alan Like "*" & veri & "*" [B][COLOR=red]and S1.cells(suz,"g")<>""[/COLOR][/B] Then
If WorksheetFunction.CountIf(S1.Range("b2:b" & suz), S1.Cells(suz, "b")) > 1 Then GoTo 10
ListBox1.AddItem
ListBox1.list(s, 0) = Sayfa1.Range("B" & suz)
s = s + 1
End If
10 Next
If WorksheetFunction.CountIf([liste!b:b], TextBox1) > 0 Then
sat =[liste!b1:b65536].Find(TextBox1).Row
TextBox21 = Format(Sheets("liste").Cells(sat, "d"), "#,##0")
TextBox6 = Sheets("liste").Cells(sat, "e")
TextBox27 = Sheets("liste").Cells(sat, "c")
End If

 

[cihangirkara]

hocam hata verdi ben size dosyayı yollasam daha iyi olmazmı vaktiniz varsa bir birde parite olayına göz atarsınız

 

[Levent Menteşoğlu]

Yukarıdaki kodu düzelttim tekrar deneyin.

 

[cihangirkara]

hocam şu firma risk yp deki pariteye bir göz atsan