Skip to main content

AccessTr.neT


Tarihler arası sorgu

Tarihler arası sorgu

Çözüldü #1
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.

.rar Vardiya Defteri.rar (Dosya Boyutu: 111,88 KB | İndirme Sayısı: 40)
Cevapla
#2
Dosya ekte.

[Resim: do.php?img=10815]

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
.rar Vardiya Defteri.rar (Dosya Boyutu: 269,32 KB | İndirme Sayısı: 12)
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da