Listboxta sayısal veri süzme

[cemal42]

Aşağıdaki kodlarla listboxta verileri süzüyorum. Ancak Optionbutton3 ile seçtiğim "S" sütununda tarihe göre süzmek istediğim zaman tarihe göre süzme yapmıyor. Daha önce "S" sütununa tarihi metin olarak giriyordum. O zaman süzme işleminde sıkıntı yoktu. Ancak "S" sütununa Tarihleri sayısal olarak olarak giriş yapınca süzme işleminde sıkıntı doğdu. Problemin çözümü için aşağıdaki kodlarda nasıl bir değişiklik yapılacağı hususunda yardımlarınızı bekliyorum. İyi çalışmalar.


Private Sub TextBox30_Change()
If OptionButton1.Value = True Then sut = "C"
If OptionButton2.Value = True Then sut = "D"
If OptionButton3.Value = True Then sut = "S"


Dim k As Range, adrs As String, j As Byte, a, sat As Long
ReDim myarr(0 To 18, 1 To 1)
If TextBox25.Text = "" Then
sat = ActiveSheet.Cells(65536, "A").End(xlUp).Row
ListBox1.RowSource = ComboBox1.Text & "!A3:S" & sat
Exit Sub
End If
Set sy1 = Sheets("" & ComboBox1)
With sy1
ListBox1.RowSource = ""
If .FilterMode Then .ShowAllData
Set k = .Range(sut & "3:" & sut & "65536").Find(TextBox25.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(0 To 18, 1 To a)
For j = 0 To 17
myarr(j, a) = .Cells(k.Row, j + 1).Value
Next j
For Z = 18 To 18
myarr(Z, a) = Format(.Cells(k.Row, Z + 1).Value, "dd.mm.yyyy")
Next Z
Set k = sy1.Range(sut & "3:" & sut & "65536").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox1.Column = myarr
End If
End With


End Sub

 

[Korhan Ayhan]

Selamlar,

Konuyla ilgili örnek dosya eklermisiniz.

 

[cemal42]

Örnek dosyayı ekledim. İyi çalışmalar

 

[cemal42]

Cevap alma ihtimalimiz varmı?

 

[Korhan Ayhan]

Selamlar,

Arama kutusuna ait kodu aşağıdaki ile değiştirip deneyiniz.

Private Sub TextBox30_Change() 'VERI ARAMA
    If OptionButton1.Value = True Then sut = "C"
    If OptionButton2.Value = True Then sut = "D"
    If OptionButton3.Value = True Then sut = "S"
    
    Dim k As Range, adrs As String, j As Byte, a, sat As Long
    ReDim myarr(0 To 18, 1 To 1)
    If TextBox30.Text = "" Then
    sat = ActiveSheet.Cells(65536, "A").End(xlUp).Row
    ListBox1.RowSource = ComboBox1.Text & "!A2:S" & sat
    Exit Sub
    End If
    
    If OptionButton3.Value = True And Len(TextBox30) <> 10 Then Exit Sub
    
    Set sy1 = Sheets("" & ComboBox1)
    With sy1
    ListBox1.RowSource = ""
    If .FilterMode Then .ShowAllData
    If OptionButton3.Value = True Then
    Set k = .Range(sut & "2:" & sut & "65536").Find(CDate(TextBox30))
    Else
    Set k = .Range(sut & "2:" & sut & "65536").Find(TextBox30.Text & "*", , xlValues, xlWhole)
    End If
    
    If Not k Is Nothing Then
    adrs = k.Address
    Do
    a = a + 1
    ReDim Preserve myarr(0 To 18, 1 To a)
    For j = 0 To 17
    myarr(j, a) = .Cells(k.Row, j + 1).Value
    Next j
    For Z = 18 To 18
            myarr(Z, a) = Format(.Cells(k.Row, Z + 1).Value, "dd.mm.yyyy")
    Next Z
    Set k = sy1.Range(sut & "2:" & sut & "65536").FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adrs
    ListBox1.Column = myarr
    End If
    End With
End Sub

Ayrıca formunuzun kod bölümüne aşağıdaki kodlarıda ekleyiniz.

Private Sub OptionButton1_Click()
    With TextBox30
        .Value = Empty
        .SetFocus
    End With
End Sub
 
Private Sub OptionButton2_Click()
    With TextBox30
        .Value = Empty
        .SetFocus
    End With
End Sub
 
Private Sub OptionButton3_Click()
    With TextBox30
        .Value = Empty
        .SetFocus
    End With
End Sub

 

[cemal42]

Sayın Korhan Ayhan, kodlar için teşekkür ederim. Elinize sağlık.