Makro Tarih sıralama ve Tarih görünüm sorunu

[walabi]

Merhaba,

Ekli excel dosyası kendimce hazırlamaya çalıştığım bir raporlama aracı. Ancak şöylesi bir problem görünüyor. Excel sayfasından alınan verilerde tarih olanların bazıları farklı görünüyor. Örneğin 11.01.2021 şeklinde olan tarih verisi listbox üzerinde 01.11.2021 olarak görünüyor. Listboxdaki verileri excel sayfasına aktardığımda 11 ocak 2021 tarihi 1 ekim 2021 oluyor. Bunun nedeni ne olabilir ya da nasıl düzeltilebilir. Excelin sayfasındaki tarih verilerini önce sayı olarak alıp sonra tarihe çevirmek mantıklı olur mu.

Excel dosyasındaki userform1 e ctrl + g ile ulaşılabilir.

 

[ÖmerFaruk]

Sizin tarih formatında sıkıntınız var.
12.04.2021 diye girdiğimde, Dizx fonksiyonunuz bunu 4 aralık olarak okuyor.

 

[walabi]

Sizin tarih formatında sıkıntınız var.
12.04.2021 diye girdiğimde, Dizx fonksiyonunuz bunu 4 aralık olarak okuyor.

Tarih formatında sıkıntı var dediğiniz yer neresi. Textboxlara girilen tarih biçimi mi, arama butonu kodlarında mı sıkıntı var. Yani nereyi düzeltmem gerekiyor. Geçenlerde buna benzer bir konu ile ilgili yine cevap vermiştiniz.

 

[ÖmerFaruk]

Mesela CommandButton2 kodlarında ListBoxa veri alırken tarih sütunu için
.List(.ListCount - 1, 0) = veri.Cells(i, TextBox1.Value)
bu satır yerine aşağıdakini kullanın
.List(.ListCount - 1, 0) = CDate(veri.Cells(i, TextBox1.Value))

Ayrıca tavsiyem, Textboxa tarih girişi yaparken oldukça zorlanıyor insan.
Nokta koyma işini ya iyi irdeleyin, ya da girilen tarih değerleri gerçek bir tarih değil ya da hatalı bir giriş ise bunu Textbox Exit olayında kontrol edin.

 

[walabi]

Mesela CommandButton2 kodlarında ListBoxa veri alırken tarih sütunu için
.List(.ListCount - 1, 0) = veri.Cells(i, TextBox1.Value)
bu satır yerine aşağıdakini kullanın
.List(.ListCount - 1, 0) = CDate(veri.Cells(i, TextBox1.Value))

Ayrıca tavsiyem, Textboxa tarih girişi yaparken oldukça zorlanıyor insan.
Nokta koyma işini ya iyi irdeleyin, ya da girilen tarih değerleri gerçek bir tarih değil ya da hatalı bir giriş ise bunu Textbox Exit olayında kontrol edin.

Ömer Faruk bey, dediğiniz gibi yaptım ancak sonuç değişmedi. Bazı satır verilerinin ay ve günleri yer değiştiriyor. Nokta olayını değiştirebilirim duruma göre ama probleme sebep olan şey bu değil sanırım. Teşekkürler tavsiyeniz. İnceleyeceğim.

 

[ÖmerFaruk]

CommandButton1 kodlarında dediğim değişikliği yaptım ve İki Tarih Arası sıraladım.


Dosyanın bu hali de ekte.

 

[walabi]

CommandButton1 kodlarında dediğim değişikliği yaptım ve İki Tarih Arası sıraladım.
Ekli dosyayı görüntüle 230475

Dosyanın bu hali de ekte.

Teşekkürler
bakacağım

 

[walabi]

CommandButton1 kodlarında dediğim değişikliği yaptım ve İki Tarih Arası sıraladım.
Ekli dosyayı görüntüle 230475

Dosyanın bu hali de ekte.

Ömer Bey merhaba,

Yüklediğiniz dosya benim yüklediğim dosyanın asıl hali olabilir mi, indirdiğim dosyaya baktığımda ne kodlarda ne de listboxa alınan verilerde bir farklılık göremedim. Resimdeki görselden anladığım tarihin listboxa yansıması değişmemiş. En son satırda 4.12.2021 ifadesi 12.04.2021 olmalı sanırım. benim verilerimde aralık verisi hiç yoktu. ilk satırlar Gün/AY/ Yıl şeklinde, son satırlar Ay/GüN/Yıl şeklinde. Resimden anladığım bunlar.

 

[ÖmerFaruk]

Dosyanıza tekrar baktım.
Kodlarınız CommanButton2 için değiştirdim. Userform üzerinde tarih sütunu ve listbox sütun başlıkları ile ilgili kısımları dikkate almadım.
Verileri süzme ve sıralama işini ADO ile yaptım.

CommandButton2 kodlarınızı aşağıdakiyle değiştirin

Private Sub CommandButton2_Click()
    If TextBox12 = "" Or Not IsDate(CDate(TextBox12)) Then MsgBox ("Hatalı Veri"): TextBox12.SetFocus: Exit Sub
    If TextBox13 = "" Or Not IsDate(CDate(TextBox13)) Then MsgBox ("Hatalı Veri"): TextBox13.SetFocus: Exit Sub
    Label13.Caption = ""
    With ListBox1
            .ColumnCount = 4
            .ColumnWidths = "60;60;60;60"
    End With
    Call ADO_VeriAl
    Label13.Caption = ListBox1.ListCount - 1 & " adet satır listelenmekte"
    mesaj
End Sub

Userform kod sayfasına aşağıdaki yeni ADO sorgusu içeren kodları da yapıştırın
ve unutmayın Referanlar kısmında Microsoft ActiveX Data Objects 6.1 Library işaretli durumda

Sub ADO_VeriAl()
Dim objADO As ADODB.Connection, objRS As ADODB.Recordset
Dim strFile As String, strSQL As String

    Set objADO = New ADODB.Connection
    Set objRS = New ADODB.Recordset
    strFile = ThisWorkbook.FullName
    With objADO
        If Val(Application.Version) < 14 Then
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Properties("Extended Properties") = "Excel 8.0; HDR=No;IMEX=1;"
        Else
            .Provider = "Microsoft.Ace.OLEDB.12.0"
            .Properties("Extended Properties") = "Excel 12.0; HDR=No;IMEX=1;"
        End If
       .ConnectionString = strFile
       .Open
    End With

    t1 = CDate(TextBox12): t2 = CDate(TextBox13)
    If OptionButton1 Then Sıralama = " Order By f1 Asc"
    
    strSQL = "Select Format(f1,'dd.mm.yyyy'),f2,f3,f4 from [Sayfa1$A2:D9999] " _
           & " Where clng(cdate(f1)) >=" & CLng(CDate(t1)) & " and clng(cdate(f1)) <=" & CLng(CDate(t2)) & Sıralama
    
    With objRS
       .CursorType = adOpenStatic
       .CursorLocation = adUseClient
       .LockType = adLockBatchOptimistic
       .ActiveConnection = objADO
       .Source = strSQL
       .Open
    End With
    
    If Not objRS.EOF Then ListBox1.Column = objRS.getrows
    If objRS.State = adStateOpen Then objRS.Close
    If objADO.State = adStateOpen Then objADO.Close
    
    Set objRS = Nothing: Set objADO = Nothing
End Sub

 

[walabi]

Dosyanıza tekrar baktım.
Kodlarınız CommanButton2 için değiştirdim. Userform üzerinde tarih sütunu ve listbox sütun başlıkları ile ilgili kısımları dikkate almadım.
Verileri süzme ve sıralama işini ADO ile yaptım.

CommandButton2 kodlarınızı aşağıdakiyle değiştirin

Private Sub CommandButton2_Click()
    If TextBox12 = "" Or Not IsDate(CDate(TextBox12)) Then MsgBox ("Hatalı Veri"): TextBox12.SetFocus: Exit Sub
    If TextBox13 = "" Or Not IsDate(CDate(TextBox13)) Then MsgBox ("Hatalı Veri"): TextBox13.SetFocus: Exit Sub
    Label13.Caption = ""
    With ListBox1
            .ColumnCount = 4
            .ColumnWidths = "60;60;60;60"
    End With
    Call ADO_VeriAl
    Label13.Caption = ListBox1.ListCount - 1 & " adet satır listelenmekte"
    mesaj
End Sub

Userform kod sayfasına aşağıdaki yeni ADO sorgusu içeren kodları da yapıştırın
ve unutmayın Referanlar kısmında Microsoft ActiveX Data Objects 6.1 Library işaretli durumda

Sub ADO_VeriAl()
Dim objADO As ADODB.Connection, objRS As ADODB.Recordset
Dim strFile As String, strSQL As String

    Set objADO = New ADODB.Connection
    Set objRS = New ADODB.Recordset
    strFile = ThisWorkbook.FullName
    With objADO
        If Val(Application.Version) < 14 Then
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Properties("Extended Properties") = "Excel 8.0; HDR=No;IMEX=1;"
        Else
            .Provider = "Microsoft.Ace.OLEDB.12.0"
            .Properties("Extended Properties") = "Excel 12.0; HDR=No;IMEX=1;"
        End If
       .ConnectionString = strFile
       .Open
    End With

    t1 = CDate(TextBox12): t2 = CDate(TextBox13)
    If OptionButton1 Then Sıralama = " Order By f1 Asc"
   
    strSQL = "Select Format(f1,'dd.mm.yyyy'),f2,f3,f4 from [Sayfa1$A2:D9999] " _
           & " Where clng(cdate(f1)) >=" & CLng(CDate(t1)) & " and clng(cdate(f1)) <=" & CLng(CDate(t2)) & Sıralama
   
    With objRS
       .CursorType = adOpenStatic
       .CursorLocation = adUseClient
       .LockType = adLockBatchOptimistic
       .ActiveConnection = objADO
       .Source = strSQL
       .Open
    End With
   
    If Not objRS.EOF Then ListBox1.Column = objRS.getrows
    If objRS.State = adStateOpen Then objRS.Close
    If objADO.State = adStateOpen Then objADO.Close
   
    Set objRS = Nothing: Set objADO = Nothing
End Sub

Ömer faruk bey, yarın kodlarınızı uygulama şansım olacak. Öncelikle teşekkürler. Yalnız şunu belirtmek istedim. Listboxa alınan tarih verilerini vba ile ne denediysem düzgün sıralatamadım. Bunun sebebi ise, eğer yanlış anlamadıysam Gün/Ay Ay/Gün çevirmesinde mutlaka bir hata ile karşılaştım. Açıkcası sebebini merak ettim. Kodlarınızı yarın deneyeceğim.