+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Tarihler arası sorgu (/konu-tarihler-arasi-sorgu.html)
Tarihler arası sorgu - celikci - 12/12/2014
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.
Vardiya Defteri.rar
(Dosya Boyutu: 111,88 KB | İndirme Sayısı: 40)
RE: Tarihler arası sorgu - feraz - 19/03/2021
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 SubPrivate 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