AccessTr.neT

Dosya ekleyebilirsiniz.

problemin çözülmüş son halini ilk mesaja ekledim
sn. @feraz silinmesi gereken yerleri bozulur falan diye silemedim böyle de çok güzel

(28/03/2020, 11:47)accessman yazdı: [ -> ]problemin çözülmüş son halini ilk mesaja ekledim

İlk mesajdaki örnek uygulamanızı değiştirmenizdeki amaç nedir? Sorunun ilk halini merak edenler nasıl ulaşacak. Sizce 

(06/07/2009, 23:57)AccessTr.neT yazdı: [ -> ]15-) Konu eklendikten sonra, konu başlığının ve/veya mesajınızın tamamını “çözüldü”, “gerek kalmadı”, “iptal” vb. şekilde değiştirmek yasaktır. Konu başlığındaki ve/veya mesajdaki imla hatalarını düzeltebilirsiniz ancak konu başlığının ve/veya mesaj içeriğinin tamamını, sorun çözüldükten sonra da soru içerikli örnek uygulamanızı değiştiremezsiniz. 
İlk ihlalde uyarı puanı verilecektir. 
Uyarı Bitiş Süresi : 6 Ay,
Uyarı Seviyesi +8

şeklindeki site kuralı niye eklenmiş olabilir?

evet doğru haklısınız

Normalde kronik alan için  strSQL yerlerine order by kronik ekleyince sıralanması gerek lakin tam sıralanmıyor.
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

Üstad sıralatmaları yaptım.

Hızı fazla verilerde denersiniz olmazsa sıralamasız olanı kullanırsınız.