combo ile bir yada iki kriterli süzme

[sarisakal]

Sorum dosyada arkadaşlar.................

 

[Levent Menteşoğlu]

Size iki yol önereceğim.

1-Autofilter özelliğini kullanarak. Aşağıdaki kodları dosyanızdaki userformun kod sayfasına kopyalayıp çalıştırın.

[vb:1:d6cf474478]Dim sonsat As Integer

Private Sub ComboBox1_Click()
Range("a1:i" & sonsat).AutoFilter Field:=1, Criteria1:=ComboBox1.Value
End Sub
Private Sub ComboBox2_Click()
Range("a1:i" & sonsat).AutoFilter Field:=2, Criteria1:=ComboBox2.Value
End Sub

Private Sub CommandButton1_Click()
Sheets("kayıt").[a1:i65536].ClearContents
[a1].CurrentRegion.Copy
Sheets("kayıt").[a1].PasteSpecial
Application.CutCopyMode = False
Range("a1:i" & sonsat).AutoFilter Field:=1
Range("a1:i" & sonsat).AutoFilter Field:=2
Unload Me
Sheets("kayıt").Select
If [b1] <> [b2] Then Rows(1).Delete
[j1].Select
End Sub

Private Sub UserForm_Initialize()
sonsat = [a65536].End(xlUp).Row
Range("A1:I" & sonsat).Sort Key1:=[a1], Key2:=[b1]
For a = 1 To sonsat
If WorksheetFunction.CountIf(Range("a1:a" & a), Cells(a, 1)) = 1 Then ComboBox1.AddItem Cells(a, 1)
If WorksheetFunction.CountIf(Range("b1:b" & a), Cells(a, 2)) = 1 Then ComboBox2.AddItem Cells(a, 2)
Next
Range("a1:i" & sonsat).AutoFilter
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Range("a1:i" & sonsat).AutoFilter
End Sub
[/vb:1:d6cf474478]

2-Döngü kullanarak, yine aşağıdaki kodları userformun kod sayfasına kopyalayın.

[vb:1:d6cf474478]Dim sonsat As Integer

Private Sub CommandButton1_Click()
Sheets("kayıt").[a1:i65536].ClearContents
For a = 1 To sonsat
If Cells(a, 1) = ComboBox1.Value * 1 And Cells(a, 2) = ComboBox2.Value Then
c = c + 1
For b = 1 To 9
Sheets("kayıt").Cells(c, b) = Cells(a, b).Value
Next
End If
Next
End Sub

Private Sub UserForm_Initialize()
sonsat = [a65536].End(xlUp).Row
Range("A1:I" & sonsat).Sort Key1:=[a1], Key2:=[b1]
For a = 1 To sonsat
If WorksheetFunction.CountIf(Range("a1:a" & a), Cells(a, 1)) = 1 Then ComboBox1.AddItem Cells(a, 1)
If WorksheetFunction.CountIf(Range("b1:b" & a), Cells(a, 2)) = 1 Then ComboBox2.AddItem Cells(a, 2)
Next
End Sub
[/vb:1:d6cf474478]

 

[sarisakal]

iki kod da ne yazık ki olmadı.
1.si hiç çalışmadı
2.nin ise hata veriyor.
Sheets("kayıt").[a1:i65536].ClearContents kodu hata veriyor

 

[Levent Menteşoğlu]

Her iki koduda deneyerek gönderdim. Sanırım yanlış yere kopyalıyorsunuz. Userformu çift tıklayın ve açılan sayfaya yukarıdaki iki koduda önce birini kopyalayıp deneyin. Daha sonra ilk kodların tamamını silin ve ikinci kodları kopyalayıp deneyin.

 

[Levent Menteşoğlu]

İlk koddaki küçük bir hata varmış şimdi onuda düzelttim. Ekteki dosyalarıda inceleyebilirsiniz.

 

[sarisakal]

gönderdiğiniz dosyaları denedim.Hala aynı hataları veriyorlar.Birinde aşagıdaki hata çıkıyor.

run-time eroor "1004"
Method 'range' of object'_Global failed

Diğerinde hala ilk kodda hata veriyor.
Benim bilgisayarda mı sorun var acaba.............

 

[Levent Menteşoğlu]

Bende hata vermedi, bir başka arkadaştanda denemesini rica ediyorum.

 

[sarisakal]

Döngünün kullanıldığı cevabınızda
"Sheets("KAYIT").[a1:i65536].ClearContents"
kodu silinirse hata vermiyor.Ama o zaman kayıt sayfası temizlenmediği için eski bilgilerden kalanlar oluyor.Sayfayı temizlemek için başka bir kod kullanabilir miyiz.

bir sorum daha vardı.combobox tan sadece birini seçtiğimde de aynı işlemi yapmak istiyorum.

Þimdiye kadar ki yardımlarınız için teşekkür ederim.
Üzerlerinde çalışırsam ben de bir çıkış yolu bulabilirim zannedersem.............

 

[SGM020]

İkisi de bende çalıştı hata yok.

 

[muallim]

İyi Ramazanlar.
Dosyaların ikisi de hatasız çalışıyor. Yalnız kayıt sayfasına süzülen bilgilerin tamamını kopyalıyor. Veri sayfasından sadece Ã?rneğin C ve E sütunlarındaki süzülmüş bilgieri kopyalayabilir miyiz?