• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Filitreleme ve otomatik süzme

M

mkstyle

Katılım
31 Ağustos 2009
Mesajlar
44
Excel Vers. ve Dili
office 2007-trkçe
Bir form üzerindeki 4 combobox sıra ile ile bir sayfa üzerinde otomatik ve mükerrersiz süzme yapmak istiyorum. Formda bu konuyla ilgili bilgiye rastlamadım. Yada ben acemi olduğum için bulamadım veya yanlış yerde arıyorum.Detaylı açıklama ilk sayfada mevcut.Yardımcı olacak arkadaşlara şimdiden teşekkürler.
 

Ekli dosyalar

mkstyle' Alıntı:
Bir form üzerindeki 4 combobox sıra ile ile bir sayfa üzerinde otomatik ve mükerrersiz süzme yapmak istiyorum. Formda bu konuyla ilgili bilgiye rastlamadım. Yada ben acemi olduğum için bulamadım veya yanlış yerde arıyorum.Detaylı açıklama ilk sayfada mevcut.Yardımcı olacak arkadaşlara şimdiden teşekkürler.
Genişletmek için tıkla ...

Merhaba
Userform'un kod bölümüne kopyalayın ve deneyin.
Kod: 
Option Explicit
Private Sub ComboBox1_Change()
Dim ts, kaplan As New Collection, trabzonspor As Range, bordo
Set bordo = Sheets("Sayfa2")
If ComboBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If bordo.Cells(ts, "A") = CDbl(ComboBox1) Then
kaplan.Add bordo.Cells(ts, "B"), CStr(bordo.Cells(ts, "B"))
End If
Next
ComboBox2.Clear
For Each trabzonspor In kaplan
ComboBox2.AddItem trabzonspor
Next
End Sub
Private Sub ComboBox2_Change()
Dim ts, kaplan As New Collection, trabzonspor As Range, bordo
Set bordo = Sheets("Sayfa2")
If ComboBox2.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If bordo.Cells(ts, "A") = CDbl(ComboBox1) And _
bordo.Cells(ts, "B") = CDbl(ComboBox2) Then
kaplan.Add bordo.Cells(ts, "C"), CStr(bordo.Cells(ts, "C"))
End If
Next
ComboBox3.Clear
For Each trabzonspor In kaplan
ComboBox3.AddItem trabzonspor
Next
End Sub
Private Sub ComboBox3_Change()
Dim ts, kaplan As New Collection, trabzonspor As Range, bordo
Set bordo = Sheets("Sayfa2")
If ComboBox3.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If bordo.Cells(ts, "A") = CDbl(ComboBox1) And _
bordo.Cells(ts, "B") = CDbl(ComboBox2) And _
bordo.Cells(ts, "C") = CDbl(ComboBox3) Then
kaplan.Add bordo.Cells(ts, "D"), CStr(bordo.Cells(ts, "D"))
End If
Next
ComboBox4.Clear
For Each trabzonspor In kaplan
ComboBox4.AddItem trabzonspor
Next
End Sub
Private Sub UserForm_Initialize()
Dim ts, bordo
Set bordo = Sheets("Sayfa2")
For ts = 2 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(bordo.Range("A2:A" & ts), _
bordo.Cells(ts, "A")) = 1 Then
ComboBox1.AddItem bordo.Cells(ts, "A")
End If
Next
End Sub
 
Hayırlı sabahlar Sayın Hocam.
Yukarıda verdiğiniz kodları "Userform'un kod bölümüne kopyalayın" diyorsunuz. Ben formdaki Comboboxların change() olayına kopyalanacak diye anladım ve kopyaladım. Sonucta Comboboxların içi boş görünüyor. Yada ben nerede yanlış yapıyorum.
 
mkstyle' Alıntı:
Hayırlı sabahlar Sayın Hocam.
Yukarıda verdiğiniz kodları "Userform'un kod bölümüne kopyalayın" diyorsunuz. Ben formdaki Comboboxların change() olayına kopyalanacak diye anladım ve kopyaladım. Sonucta Comboboxların içi boş görünüyor. Yada ben nerede yanlış yapıyorum.
Genişletmek için tıkla ...

Yazdığımı doğru okumuşsunuz ama yanlış anlamışsınız.
Userform'un kod bölümünde bulunan tüm kodları silin ve yukarıda benim verdiğim kodları ekleyin. Sonra Userform'u çalıştırın ve deneyin.
 
Hocam özür. Acemiliğime bağışlayın. Kod Form üzerinde mükemmel çalışıyor. Süzmeler harika. Yalnız süzmelerin sayfa üzerinde de görülmesi lazım. Zira sayfa üzerinde matematiksel işlem yaptırıyorum. Çok teşekkür ederim (A.R.O)
 
mkstyle' Alıntı:
Hocam özür. Acemiliğime bağışlayın. Kod Form üzerinde mükemmel çalışıyor. Süzmeler harika. Yalnız süzmelerin sayfa üzerinde de görülmesi lazım. Zira sayfa üzerinde matematiksel işlem yaptırıyorum. Çok teşekkür ederim (A.R.O)
Genişletmek için tıkla ...

Merhaba
Öncelikle kelimelerimizi lütfen kısaltmadan kullanalım.
Userform'un kod bölümündeki kodu bununla değiştirip dener misiniz_?
Kod: 
Option Explicit
Private Sub ComboBox1_Change()
Dim ts, kaplan As New Collection, trabzonspor As Range, bordo
Set bordo = Sheets("Sayfa2")
If ComboBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If bordo.Cells(ts, "A") = CDbl(ComboBox1) Then
kaplan.Add bordo.Cells(ts, "B"), CStr(bordo.Cells(ts, "B"))
End If
Next
ComboBox2.Clear
For Each trabzonspor In kaplan
ComboBox2.AddItem trabzonspor
Next
ts = bordo.Range("A" & Rows.Count).End(xlUp).Row
bordo.Range("A2:F" & ts).AutoFilter field:=1, Criteria1:=ComboBox1.Text
End Sub
Private Sub ComboBox2_Change()
Dim ts, kaplan As New Collection, trabzonspor As Range, bordo
Set bordo = Sheets("Sayfa2")
If ComboBox2.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If bordo.Cells(ts, "A") = CDbl(ComboBox1) And _
bordo.Cells(ts, "B") = CDbl(ComboBox2) Then
kaplan.Add bordo.Cells(ts, "C"), CStr(bordo.Cells(ts, "C"))
End If
Next
ComboBox3.Clear
For Each trabzonspor In kaplan
ComboBox3.AddItem trabzonspor
Next
ts = bordo.Range("A" & Rows.Count).End(xlUp).Row
bordo.Range("A2:F" & ts).AutoFilter field:=2, Criteria1:=ComboBox2.Text
End Sub
Private Sub ComboBox3_Change()
Dim ts, kaplan As New Collection, trabzonspor As Range, bordo
Set bordo = Sheets("Sayfa2")
If ComboBox3.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If bordo.Cells(ts, "A") = CDbl(ComboBox1) And _
bordo.Cells(ts, "B") = CDbl(ComboBox2) And _
bordo.Cells(ts, "C") = CDbl(ComboBox3) Then
kaplan.Add bordo.Cells(ts, "D"), CStr(bordo.Cells(ts, "D"))
End If
Next
ComboBox4.Clear
For Each trabzonspor In kaplan
ComboBox4.AddItem trabzonspor
Next
ts = bordo.Range("A" & Rows.Count).End(xlUp).Row
bordo.Range("A2:F" & ts).AutoFilter field:=3, Criteria1:=ComboBox3.Text
End Sub
Private Sub ComboBox4_Change()
Dim ts, kaplan As New Collection, trabzonspor As Range, bordo
Set bordo = Sheets("Sayfa2")
ts = bordo.Range("A" & Rows.Count).End(xlUp).Row
bordo.Range("A2:F" & ts).AutoFilter field:=4, Criteria1:=ComboBox4.Text
End Sub
Private Sub CommandButton1_Click()
Dim ts, kaplan As New Collection, trabzonspor As Range, bordo
Set bordo = Sheets("Sayfa2")
ts = bordo.Range("A" & Rows.Count).End(xlUp).Row
bordo.Range("A2:F" & ts).AutoFilter field:=1
bordo.Range("A2:F" & ts).AutoFilter field:=2
bordo.Range("A2:F" & ts).AutoFilter field:=3
bordo.Range("A2:F" & ts).AutoFilter field:=4
End Sub
Private Sub UserForm_Initialize()
Dim ts, bordo
Set bordo = Sheets("Sayfa2")
CommandButton1_Click
For ts = 2 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(bordo.Range("A2:A" & ts), _
bordo.Cells(ts, "A")) = 1 Then
ComboBox1.AddItem bordo.Cells(ts, "A")
End If
Next
End Sub
 
Tek kelime ile mükemmel oldu. Allah(C.C) bin kere razı olsun.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst