Userformda İki Tarih Arası Filtreleme Kodları

[officer08]

Öncelikle iyi geceler herkese.
Hazır bir şekilde iki tarih arası filtreleme userformu buldum kendime uyarlamak istiyorum. Sayfa1'deki verilerin çekileceği kısım 6 sütundan oluşuyor (yani bilgiler A-B-C-D-E-F sütunları altında sıralı) ancak ben 2 sütun daha eklemek istiyorum.G ve H sütunları altına da veri gireceğim. Kodlar üzerinde birkaç denedim her seferinde listboxa 6 sütunluk bilgi getiriyor. Yardım ederseniz sevinirim. Kodları aşağıya yapıştırıyorum

Private Sub CommandButton1_Click()
Dim i As Long
If ComboBox1.Value = "" Or ComboBox2.Value = "" Then
MsgBox "Please Choose Date", vbCritical, ""
Exit Sub
End If
Label1.Caption = ComboBox1.Value
Label2.Caption = ComboBox2.Value

ListBox1.Clear
For i = 2 To Sheets("Sayfa1").Range("a65536").End(3).Row
If VBA.CLng(VBA.CDate(Cells(i, "a").Value)) >= VBA.CLng(VBA.CDate(ComboBox1.Value)) And VBA.CLng(VBA.CDate(Cells(i, "a").Value)) <= VBA.CLng(VBA.CDate(ComboBox2.Value)) Then
With ListBox1
.AddItem VBA.Format(Cells(i, 1).Value, "dd.mm.yyyy")
.List(.ListCount - 1, 1) = Cells(i, 2).Value
.List(.ListCount - 1, 2) = Cells(i, 3).Value
.List(.ListCount - 1, 3) = Cells(i, 4).Value
.List(.ListCount - 1, 4) = Cells(i, 5).Value
.List(.ListCount - 1, 5) = VBA.Format(Cells(i, 6).Value, "#,##0.00")

End With
End If
Next i
i = Empty
End Sub

Private Sub UserForm_Initialize()
Dim a As Variant, hcr As Range
Dim pk As Worksheet

ListBox1.ColumnCount = 6
ListBox1.ColumnWidths = "60,60,55,55,55,60"

ComboBox1.Clear
ComboBox2.Clear
Set pk = Sheets("Sayfa1")
With pk.Range("A2" & Cells(Rows.Count, "A").End(xlUp).Row)
.Sort Key1:=Range("A2"), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
End With


With CreateObject("Scripting.Dictionary")
For Each hcr In pk.Range("A2:A" & pk.Cells(65536, "A").End(xlUp).Row)
If Not .exists(hcr.Value) Then
.Add VBA.Format(hcr.Value, "dd.mm.yyyy"), Nothing
End If
Next hcr
a = .keys
End With



ComboBox1.List = a
ComboBox2.List = a

End Sub

 

[vardar07]

Buyurun.

Private Sub CommandButton1_Click()
Dim i As Long
If ComboBox1.Value = "" Or ComboBox2.Value = "" Then
MsgBox "Please Choose Date", vbCritical, ""
Exit Sub
End If
Label1.Caption = ComboBox1.Value
Label2.Caption = ComboBox2.Value

ListBox1.Clear
For i = 2 To Sheets("Sayfa1").Range("a65536").End(3).Row
If VBA.CLng(VBA.CDate(Cells(i, "a").Value)) >= VBA.CLng(VBA.CDate(ComboBox1.Value)) And VBA.CLng(VBA.CDate(Cells(i, "a").Value)) <= VBA.CLng(VBA.CDate(ComboBox2.Value)) Then
With ListBox1
.AddItem VBA.Format(Cells(i, 1).Value, "dd.mm.yyyy")
.List(.ListCount - 1, 1) = Cells(i, 2).Value
.List(.ListCount - 1, 2) = Cells(i, 3).Value
.List(.ListCount - 1, 3) = Cells(i, 4).Value
.List(.ListCount - 1, 4) = Cells(i, 5).Value
.List(.ListCount - 1, 5) = VBA.Format(Cells(i, 6).Value, "#,##0.00")
[COLOR="Red"].List(.ListCount - 1, 6) = Cells(i, 7).Value
.List(.ListCount - 1, 7) =Cells(i, 8).Value
[/COLOR]
End With
End If
Next i
i = Empty
End Sub

Private Sub UserForm_Initialize()
Dim a As Variant, hcr As Range
Dim pk As Worksheet

ListBox1.ColumnCount = 6
ListBox1.ColumnWidths = "60,60,55,55,55,55,[COLOR="red"]55,60[/COLOR]"

ComboBox1.Clear
ComboBox2.Clear
Set pk = Sheets("Sayfa1")
With pk.Range("A2" & Cells(Rows.Count, "A").End(xlUp).Row)
.Sort Key1:=Range("A2"), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
End With


With CreateObject("Scripting.Dictionary")
For Each hcr In pk.Range("A2:A" & pk.Cells(65536, "A").End(xlUp).Row)
If Not .exists(hcr.Value) Then
.Add VBA.Format(hcr.Value, "dd.mm.yyyy"), Nothing
End If
Next hcr
a = .keys
End With



ComboBox1.List = a
ComboBox2.List = a

End Sub

 

[officer08]

Yapıştırdım ancak olmadı, açmadı user formu "Range sınıfının Sort Yöntemi başarısız" diyor

 

[vardar07]

Ozaman dosyanızı ekleyin bakalım.

 

[officer08]

sizin yaptığınız üzerinden kurcalarken. Aşağıda gösterdiğim yerleri değiştirince oldu. Çok teşekkür ederim bu saatte ve kısa zamanda yardımlarınız için.
With ListBox1
.AddItem VBA.Format(Cells(i, 1).Value, "dd.mm.yyyy")
.List(.ListCount - 1, 1) = Cells(i, 2).Value
.List(.ListCount - 1, 2) = Cells(i, 3).Value
.List(.ListCount - 1, 3) = Cells(i, 4).Value
.List(.ListCount - 1, 4) = Cells(i, 5).Value
.List(.ListCount - 1, 5) = Cells(i, 6).Value
.List(.ListCount - 1, 6) = Cells(i, 7).Value
.List(.ListCount - 1, 7) = Cells(i, 8).Value
.List(.ListCount - 1, 8) = VBA.Format(Cells(i, 9).Value, "#,##0.00")

End With
End If
Next i
i = Empty
End Sub

Private Sub UserForm_Initialize()
Dim a As Variant, hcr As Range
Dim pk As Worksheet

ListBox1.ColumnCount = 8
ListBox1.ColumnWidths = "60,60,55,55,55,60,55,55"

 

[vardar07]

Rica ederim.