Bence sorgu1 sorgusuna gerek yok.
Alttaki kodu deneyebilirsiniz * bunu unutmuşsunuz diğer kod satırına eklemeyi ve arr olanları sildim.
Sayıları sıralatmayı yapamadım daha bu listbox farklı olduğu için bakalım artık.
Option Compare Database
'" WHERE DateTimeValue >= #" & Format(aDateTimeVariable, "yyyy-mm-dd hh:nn:ss") & "#;"
'" AND Tablo1.bastarih <= #" & Format([sontarih], "dd-mm-yyyy") & "#" & _
Private Sub Komut18_Click()
Dim strSQL As String
If (sqltur.Value = 1) Then
strSQL = "SELECT * FROM Tablo1" & _
" WHERE firma='" & [Metin13] & "'" & _
" AND not isnull(kronik)" & _
" AND (CLng(bastarih)<=" & CLng(Me.sontarih) & ")" & _
" AND (CLng(bittarih)>=" & CLng(Me.ilktarih) & ")"
Else
strSQL = " select * from tablo1 where [id] not in ( select [id] from tablo1 where clng(bastarih)>=" & CLng(Me.sontarih) & _
" or clng(bittarih)<=" & CLng(Me.ilktarih) & ") and Tablo1.firma='" & [Metin13] & "'"
End If
listele strSQL, Me.Liste19, 2
End Sub
Private Sub listele(strSQL As String, lst As ListBox, index As Integer)
On Error Resume Next
Dim rs As Object
Dim cn As Object
Dim scr As Object
Dim k As Long, kes, i As Long
Set scr = CreateObject("scripting.dictionary")
scr.CompareMode = TextCompare
Set rs = CreateObject("ADODB.Recordset")
Set cn = CreateObject("ADODB.Connection")
Set cn = CurrentProject.Connection
With rs
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open strSQL, cn, , , 1
End With
If rs.RecordCount > 0 Then
Do While Not rs.EOF
kes = Split(rs(index), ",")
For k = LBound(kes) To UBound(kes)
scr(Trim(kes(k))) = scr(Trim(kes(k))) + 1
Next
rs.MoveNext
Loop
End If
With lst
.RowSource = Empty
If scr.Count < 1 Then GoTo son
.ColumnCount = 2
.ColumnWidths = "4Cm;2cm"
For i = 0 To scr.Count - 1
.AddItem scr.keys()(i) & ";" & scr.items()(i)
Next
End With
son:
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
Set scr = Nothing
kes = vbNullString
End Sub