userformda birden fazla kritere göre sorgulama

[1903bjk]

Merhabalar

Userform üzerinde birden fazla kritere göre sogulama yapmak istiyorum.

ilgili örnek ektedir.

Örneğin formda Personnel name kısmını "Ayşe" ve Manager Name kısmında Nilgün'ü seçtiğimizde hem "Ayşe"ye hem da "Nilgün" e göre sorgu yapması gerekiyor.

sogu kodu aşağıdaki gibidir.

Yardımlarınızi rica ederim

Saygılarımla


Dim i As Long, VERİ As String, KRİTER As String
Sheets("SCHEDULE").Select

ListBox1.Clear
ListBox2.Clear
ListBox3.Clear
ListBox4.Clear
ListBox5.Clear

KRİTER = UCase(Replace(Replace(ComboBox1.Value, "ı", "I"), "i", "İ"))
For i = 2 To Cells(65536, "D").End(xlUp).Row

If Cells(i, "G") <> "ACTIVE" Then GoTo 3 'işten çıkanları listeye dahil etmiyor

VERİ = UCase(Replace(Replace(Cells(i, "D").Value, "ı", "I"), "i", "İ"))

If VERİ Like KRİTER & "*" Then

ListBox1.AddItem Cells(i, "D").Value
ListBox2.AddItem Cells(i, "A").Value
ListBox3.AddItem Cells(i, "C").Value
ListBox4.AddItem Cells(i, "B").Value
ListBox5.AddItem Cells(i, "F").Value


End If
3 'işten çıkanları listeye dahil etmiyor
Next i
TextBox37 = ListBox1.ListCount 'LİSTBOX1 DEKİ LİSTELENEN PERSONELİN SAYISINI TEXTBOX1 'E YAZAR
End Sub

 

[1903bjk]

birden fazla kritere göre sorgu

Arkadaşlar konu hakkında yardım bekliyorum

iki combobox var

ikisindeki verye göre sorgu oluşturmak istiyorum

teşekkürler

Merhabalar

Userform üzerinde birden fazla kritere göre sogulama yapmak istiyorum.

ilgili örnek ektedir.

Örneğin formda Personnel name kısmını "Ayşe" ve Manager Name kısmında Nilgün'ü seçtiğimizde hem "Ayşe"ye hem da "Nilgün" e göre sorgu yapması gerekiyor.

sogu kodu aşağıdaki gibidir.

Yardımlarınızi rica ederim

Saygılarımla


Dim i As Long, VERİ As String, KRİTER As String
Sheets("SCHEDULE").Select

ListBox1.Clear
ListBox2.Clear
ListBox3.Clear
ListBox4.Clear
ListBox5.Clear

KRİTER = UCase(Replace(Replace(ComboBox1.Value, "ı", "I"), "i", "İ"))
For i = 2 To Cells(65536, "D").End(xlUp).Row

If Cells(i, "G") <> "ACTIVE" Then GoTo 3 'işten çıkanları listeye dahil etmiyor

VERİ = UCase(Replace(Replace(Cells(i, "D").Value, "ı", "I"), "i", "İ"))

If VERİ Like KRİTER & "*" Then

ListBox1.AddItem Cells(i, "D").Value
ListBox2.AddItem Cells(i, "A").Value
ListBox3.AddItem Cells(i, "C").Value
ListBox4.AddItem Cells(i, "B").Value
ListBox5.AddItem Cells(i, "F").Value


End If
3 'işten çıkanları listeye dahil etmiyor
Next i
TextBox37 = ListBox1.ListCount 'LİSTBOX1 DEKİ LİSTELENEN PERSONELİN SAYISINI TEXTBOX1 'E YAZAR
End Sub

 

[kartal1a]

Application.ScreenUpdating = False



'***Değişkenleri bul****
trh1 = CDate(ufkara.cbxbg.Value & "." & ufkara.cbxba.Value & "." & ufkara.cbxby.Value)
trh2 = CDate(ufkara.cbxsg.Value & "." & ufkara.cbxsa.Value & "." & ufkara.cbxsy.Value)
If ufkara.ckbsgün.Value = True Then trh1 = trh2
ek2 = StrConv(Left(ufkara.cbxişl.Value, 3), 2)
If ufkara.cbxbra.ListIndex > 0 Then sayadı = StrConv(Left(ufkara.cbxbra.Value, 3) & Right(trh2, 2) & ek2, 2): 'branş = [alnbraeki].Find(sayadı).Offset(0, 1)
branş = Left(ufkara.cbxbra.Value, 9)
sır = ufkara.tbxkay.Value
If ufkara.cbxggt.ListIndex > 0 Then ggt = ufkara.cbxggt.Value
şah_fir = ufkara.tbxffn.Value
yer = ufkara.tbxyer.Value
If ufkara.obtrşf.Value = True Then gar = "Evet"
If ufkara.obtlşf.Value = True Then gar = "Hayır"

If ufkara.tbxürü.Value <> "" Then ürün = ufkara.tbxürü.Value
If ufkara.cbxyap.ListIndex > 0 Then yap = ufkara.cbxyap.Value
If ufkara.cbxggt.ListIndex > 0 Then ggt = ufkara.cbxggt.Value
'If ufkara.cbxggt.Value <> "Gidiş Tipi" Then ggt = ufkara.cbxggt.Value
onot = ufkara.tbxnot.Value



'****************************xxxxxxxxxxxxxx
On Error Resume Next

'================================================================
tek_branşta_ara:
'------------Tek Branş seçilmişse--------------------------------
Worksheets(sayadı).Select

ActiveSheet.ShowAllData
[a1].AutoFilter 1, ">=" & CDbl(trh1), xlAnd, "<=" & CDbl(trh2)
veriss = Range("a5000").End(xlUp).Row

If veriss > 1 Then ' veri süzüldükten sonra sayfada veri varsa
If sır <> "0" Then [a1].AutoFilter 2, sır
' 2 nolu sütun tarih

' 3 no sütun belge no

If şah_fir <> "" Then [a1].AutoFilter 4, şah_fir & "*"
If yer <> "" Then [a1].AutoFilter 5, yer & "*"
If ürün <> "" Then [a1].AutoFilter 6, ürün
If yap <> "" Then [a1].AutoFilter 7, yap
If gar <> "" Then [a1].AutoFilter 8, gar
If onot <> "" Then [a1].AutoFilter 9, onot & "*"
If ggt <> "" Then [a1].AutoFilter 11, ggt

veriss = Range("a5000").End(xlUp).Row
If veriss > 1 Then
görbs = Range("a2:a" & veriss).SpecialCells(xlCellTypeVisible).Row
If veriss = 2 Then görbs = 2

Range("a" & görbs & ":l" & veriss).Copy
Sheets("liste2").Select
Range("a" & Range("a10000").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
veriss = Range("a10000").End(xlUp).Row
görbs = Range("liste2!ı10000").End(xlUp).Row + 1
'Range("liste2!ı" & görbs & ":ı" & veriss) = branş
Range("liste2!a4" & ":l" & veriss).Interior.ColorIndex = 8
End If

End If

Worksheets(sayadı).Select
ActiveSheet.AutoFilterMode = False
Application.CutCopyMode = False



çıkış:

If [liste2!B4] = "" Then
MsgBox "Kayıt Bulunamadı"
Else
Sheets("liste2").Select
Worksheets("liste2").lbltar.Caption = trh1 & " - " & trh2
Range("a4:ı4").Select
Selection.EntireColumn.AutoFit
ActiveWindow.ScrollRow = 1
[hcsayfa2].Value = "liste2"
ufkara.Hide



End If


burada kod parçasını birden fazla kriterlere göre süzdürme işi kullanıyorum belki işine yarar saygılar