• DİKKAT

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

Detaylı Arama

T

teksen

Katılım
6 Mart 2006
Mesajlar
251
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.
 
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' Alıntı:
Arkadaşlar,

Bu konuda yardımcı olabilecek kimse varmı acaba?
Genişletmek için tıkla ...

Aşağıdaki kodları deneyiniz.:cool:
Kod: 
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
 
Son düzenleme:
Teşekkür ederim,

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

dosyayı tekrar ekliyorum

bunun üzerinde denememiz mümkünmüdür acaba?
 
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.:cool:
 
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.
 
Dosyanız ekte.:cool:
Kod: 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst