AccessTr.neT

Yardımlarınız ile hazırlamaya çalıştığım çalışmada userform ile 3 farklı seçeneğe göre  iki tarih arasında sorgu yaptırmak istiyorum mümkünmüdür.Çalıştığı dosyayı ve taslak olarak hazırladığım formu ekledim.(frm_defsorgu)
Tşk eder iyi çalışmalar dilerim.

[attachment=21519]

Dosya ekte.

Sub filtrele()



Dim aranan As String, aranan2 As String

Dim son As Long, i As Long, say As Long

Dim arr()

Const sutunSayisi As Byte = 9



If Me.TextBox1.Value = "" Or Me.TextBox2.Value = "" Then GoTo sonn



Me.ListBox1.Clear

On Error GoTo sonn

With ThisWorkbook.Sheets("Sayfa1")

    son = .Cells(Rows.Count, 1).End(3).Row + 1

    For i = 3 To son

        aranan = IIf(.Cells(i, 5).Value = "", "*", .Cells(i, 5).Value) & "|" & _

                  IIf(.Cells(i, 6).Value = "", "*", .Cells(i, 6).Value) & "|" & _

                  IIf(.Cells(i, 7).Value = "", "*", .Cells(i, 7).Value)

              

        aranan2 = IIf(Me.cmb_bolum.Value = "", "*", Me.cmb_bolum.Value) & "|" & _

                  IIf(Me.cmb_ekipmanlar.Value = "", "*", Me.cmb_ekipmanlar.Value) & "|" & _

                  IIf(Me.cmb_yer.Value = "", "*", Me.cmb_yer.Value)

    

        If CLng(CDate(.Cells(i, 3).Value)) >= CLng(CDate(Me.TextBox1.Value)) And _

          CLng(CDate(.Cells(i, 3).Value)) <= CLng(CDate(Me.TextBox2.Value)) Then

        

            If aranan Like aranan2 Then

                say = say + 1

                ReDim Preserve arr(1 To sutunSayisi, 1 To say)

                arr(1, say) = .Cells(i, 2).Value

                arr(2, say) = .Cells(i, 3).Value

                arr(3, say) = .Cells(i, 4).Value

                arr(4, say) = .Cells(i, 5).Value

                arr(5, say) = .Cells(i, 6).Value

                arr(6, say) = .Cells(i, 7).Value

                arr(7, say) = .Cells(i, 8).Value

                arr(8, say) = .Cells(i, 9).Value

                arr(9, say) = .Cells(i, 10).Value

            End If

        End If

    Next

    If say > 0 Then

        With Me.ListBox1

            .ColumnCount = sutunSayisi

            .Column = arr

        End With

    End If

End With

Exit Sub

sonn:

On Error Resume Next

Erase arr

End Sub

Private Sub cmb_bolum_Change()

    filtrele

End Sub



Private Sub cmb_ekipmanlar_Change()

    filtrele

End Sub



Private Sub cmb_yer_Change()

    filtrele

End Sub



Private Sub CommandButton1_Click()

    filtrele

End Sub