Detaylı Arama

[teksen]

Arkadaşlar merhaba,

Ekteki dosyamda UserForm üzerinde sol taraftaki ComboBox lar üzerinde seçtiğim bir kritere göre arama yaptırabiliyorum.Fakat Sağ tarafta 3 kritere göre arama yaptırmayı malesef beceremedim.

bu tip bir arama için kodlarda nasıl bir değişiklik yapmamız gerekir acaba?

şimdiden teşekkür ederim.

Herkese iyi çalışmalar.

 

[teksen]

Aşağıdaki kodu buton üzerinde kullanarak 3 koşula göre arama yaptırabildim.Fakat bu seferde tamamını seçmeden arama yapmıyor.

Yani illa 3 koşulunda seçili olması gerekiyor.

ComboBox1,2 ve 3 üzerinden ComboBox 1 ve 2 yi seçtiğimizi düşünelim.

O zamanda arama yapmıyor.

Acaba nasıl bir değişiklik yapmamız gerekir?



Private Sub CommandButton1_Click()
Sheets("Sayfa1").Select
Set SV = Sheets("Sayfa1")
Set sr = Sheets("Sayfa3")
sr.Range("a2:k1000").Clear

For sut = 1 To SV.[d65536].End(xlUp).Row
If ComboBox4.Value = Range("b" & sut).Value And SV.Range("c" & sut) = ComboBox5.Value Then
If ComboBox5.Value = Range("c" & sut).Value And SV.Range("d" & sut) = ComboBox6.Value Then


Range("a" & sut & ":k" & sut).Copy
S = S + 1
sr.Range("a" & S + 1).PasteSpecial
End If

End If





Next
Application.CutCopyMode = False
sut = sr.[d65536].End(xlUp).Row

ListBox2.Visible = True
End Sub

 

[teksen]

Arkadaşlar,

Bu konuda yardımcı olabilecek kimse varmı acaba?

 

[Orion1]

Arkadaşlar,

Bu konuda yardımcı olabilecek kimse varmı acaba?

Aşağıdaki kodları deneyiniz.

Private Sub CommandButton1_Click()
Dim deg1, deg2, deg3, deg4
Sheets("Sayfa1").Select
Set SV = Sheets("Sayfa1")
Set sr = Sheets("Sayfa3")
sr.Range("a2:k1000").Clear

For sut = 1 To SV.[d65536].End(xlUp).Row
If ComboBox4.Value = "" Then
    deg1 = Range("b", sut).Value
    Else
    deg1 = ComboBox4.Value
End If
If ComboBox5.Value = "" Then
    deg2 = SV.Range("c" & sut).Value
    deg3 = Range("c", sut).Value
    Else
    deg2 = ComboBox5.Value
    deg3 = ComboBox5.Value
End If
End If
If ComboBox6.Value = "" Then
    deg4 = SV.Range("d" & sut).Value
    Else
    deg4 = ComboBox6.Value
End If
If deg1 = Range("b" & sut).Value And SV.Range("c" & sut) = deg2 Then
If deg3 = Range("c" & sut).Value And SV.Range("d" & sut) = deg4 Then



Range("a" & sut & ":k" & sut).Copy
S = S + 1
sr.Range("a" & S + 1).PasteSpecial
End If
End If
Next
Application.CutCopyMode = False
sut = sr.[d65536].End(xlUp).Row

ListBox2.Visible = True
End Sub

 

[teksen]

Teşekkür ederim,

elinize sağlık.Yalnız kodları sonlandıramadım.Daha doğrusu malesef çalıştıramadım.

 

[Orion1]

Teşekkür ederim,

elinize sağlık.Yalnız kodları sonlandıramadım.Daha doğrusu malesef çalıştıramadım.

Kodlara ilave yaptım.
4 numaralı mesajdan indirip deneyiniz.

 

[teksen]

Malesef çalıştıramadım

dosyayı tekrar ekliyorum

bunun üzerinde denememiz mümkünmüdür acaba?

 

[Orion1]

Kodlarınızdan ne yapmak istediğiniz anlamadım.
Daha açıklayıcı bilgiler yazmalısınız.
Böyle bilmece çözmeye benziyor.
Mesela 2 sayfadamı sorgulama yapılacak Bu sayfaların isimleri ne? Vs. gibi.

 

[teksen]

Sayfa 1 de bulunan bilgilerde ComboBox1 ,2,3 ve 4 üzerine her sütun ayrı ayrı geliyor.

şu anda 4 kutuyuda seçtikten sonra detaylı ara dediğimde 4 koşula göre arama yapıyor.

Fakat örneğin sadece ComboBox1 ve ComboBox3 ten seçim yapıp ara dersem aramıyor.Yani mutlaka 4 Koşuluda seçmem gerekiyor.

sorunum bu.

Yardımlarınız için teşekkür ederim.

 

[Orion1]

Dosyanız ekte.

Private Sub CommandButton1_Click()
Dim marka As String, model As String, tedarik As String
Dim cmb_adet As String, hcr_adet As String
Sheets("Sayfa1").Select
Set SV = Sheets("Sayfa1")
Set sr = Sheets("Sayfa3")
Application.ScreenUpdating = False
sr.Range("a2:k65536").Clear
S = 1
For sut = 1 To SV.[b65536].End(xlUp).Row
If ComboBox4.Value = "" Then
    marka = SV.Range("b" & sut).Value
    Else
    marka = ComboBox4.Value
End If
If ComboBox5.Value = "" Then
    model = SV.Range("c" & sut).Value
    Else
    model = ComboBox5.Value
End If
If ComboBox6.Value = "" Then
    tedarik = SV.Range("d" & sut).Value
    Else
    tedarik = ComboBox6.Value
End If
hcr_adet = SV.Range("e" & sut).Value
If ComboBox7.Value = "" Then
    cmb_adet = hcr_adet
    Else
    cmb_adet = ComboBox7.Value
End If
If marka = SV.Range("b" & sut).Value And model = SV.Range("c" & sut) And _
tedarik = SV.Range("d" & sut).Value And cmb_adet = hcr_adet Then
   
    SV.Range("a" & sut & ":k" & sut).Copy
    sr.Range("a" & S).PasteSpecial
    S = S + 1
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
ListBox2.Visible = True
ListBox2.RowSource = vbNullString
ListBox2.RowSource = "Sayfa3!A1:E" & Sheets("Sayfa3").Cells(65536, "B").End(xlUp).Row
End Sub

 

[teksen]

Teşekkür ederim Sn.Evren Gizlen

Elinize sağlık.

 

[Orion1]

Teşekkür ederim Sn.Evren Gizlen

Elinize sağlık.

Rica ederim.
iyi çalışmalar.