Listbox İki Tarih Arası Filtreleme

[serqet]

Merhaba arkadaşlar aşağıdaki kodda bir düzenleme yapmak gerekiyor yardımınızı rica ediyorum. Şuan bu kodun işlevi listbox1 deki (isim soyisim) değeri A4:g65536 aralığında arayarak aynı olanları listbox2 ye süzme işlemi yapıyor.Benim istediğim ise form üzerinde yer alan 2 adet dtpicker1 ve dtpicker2 nesnesindeki tarih aralıklarını süzsün, süzme yapılacak aralık aynı ve tarih 4. sütunda.Yardım edecek arkadaşlara şimdiden teşekkürler.


Dim k As Range, adrs As String, j As Byte, a As Long, myarr()
ReDim myarr(1 To 7, 1 To 1)
With Workbooks("Kalite.xlsm").Sheets("veri")
Me.ListBox2.RowSource = vbNullString
If .FilterMode Then .ShowAllData
Set k = .Range("A4:g65536").Find(ListBox1.Value & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 7, 1 To a)
For j = 1 To 7
myarr(j, a) = .Cells(k.Row, j).Value
Next j
On Error Resume Next
Set k = .Range("A4:g65536").FindNext(k)
On Error Resume Next
Loop While Not k Is Nothing And k.Address <> adrs
ListBox2.Column = myarr
End If
End With

 

[serqet]

aşağıdaki kodla iki tarih arası filtreleme işini yaptım fakat bu tarih aralarını filtrelerken Listbox1.value ismi ile aynı olan hücrelerin tarih aralarını filtrelemesi lazım onu beceremedim If isim >= DTPicker1 And isim <= DTPicker2 Then burayı If isim >= DTPicker1 And isim <= DTPicker2 And ListBox1.Value Then gibi birşeyler yaptım ama beceremedim. isimlerde aynı sayfada b4:b aralığında.Biri el atsın lütfen.

Private Sub CommandButton5_Click()
Dim ver As Worksheet
If DTPicker2.Enabled = False Then
MsgBox "Tarih Aralığı Seçmediniz..!", 16, "DİKKAT"
Else
Windows("Kalite.xlsm").Visible = True
Set ver = Sheets("veri")
ListBox2.RowSource = Empty
ListBox2.Clear
ListBox2.ColumnCount = 9

For Each isim In ver.Range("D2:D" & ver.Range("A30000").End(xlUp).Row)
    If isim >= DTPicker1 And isim <= DTPicker2 Then
        liste = ListBox2.ListCount
            ListBox2.AddItem
            ListBox2.list(liste, 3) = Format(isim, "dd.mm.yyyy")
            ListBox2.list(liste, 1) = isim.Offset(0, -2) 'İSİM
            ListBox2.list(liste, 0) = isim.Offset(0, -3) 'SIRA NO
            ListBox2.list(liste, 2) = isim.Offset(0, -1) 'BİRİM
            ListBox2.list(liste, 4) = isim.Offset(0, 1) 'ÇAĞRI
            ListBox2.list(liste, 5) = isim.Offset(0, 2) 'MAİL
                   

     End If
Next
End If
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi düzenleyin.

Private Sub CommandButton5_Click()
Dim ver As Worksheet
If DTPicker2.Enabled = False Then
MsgBox "Tarih Aralığı Seçmediniz..!", 16, "DİKKAT"
Else
Windows("Kalite.xlsm").Visible = True
Set ver = Sheets("veri")
ListBox2.RowSource = Empty
ListBox2.Clear
ListBox2.ColumnCount = 9

For Each isim In ver.Range("D2" & ver.Range("A30000").End(xlUp).Row)
If isim >= DTPicker1 And isim <= DTPicker2 and isim.Offset(0, -2)=listbox1.value Then
liste = ListBox2.ListCount
ListBox2.AddItem
ListBox2.list(liste, 3) = Format(isim, "dd.mm.yyyy")
ListBox2.list(liste, 1) = isim.Offset(0, -2) 'İSİM
ListBox2.list(liste, 0) = isim.Offset(0, -3) 'SIRA NO
ListBox2.list(liste, 2) = isim.Offset(0, -1) 'BİRİM
ListBox2.list(liste, 4) = isim.Offset(0, 1) 'ÇAĞRI
ListBox2.list(liste, 5) = isim.Offset(0, 2) 'MAİL


End If
Next
End If
End Sub

 

[serqet]

Çok teşekkür ederim ilginize Levent Bey, küçük bir ricam daha olacak vaktiniz varsa eğer tabi. süzülen bu verilerin e ve f sütunlarında (bazılarında) 1 yazıyor ben normalde bunları toplatıp sumif ile bir textbox'a yazdırıyordum fakat bu şekilde toplama olmuyor bunu nasıl düzeltebilirim? o kodda aşağıda.Teşekkürler.

Private Sub ListBox1_Click()
Dim ar As Integer
Dim aw As Integer
ar = WorksheetFunction.SumIf([[Kalite.xlsm]veri!B:B], ListBox1.Value, [[Kalite.xlsm]veri!e:e])
aw = WorksheetFunction.SumIf([[Kalite.xlsm]veri!B:B], ListBox1.Value, [[Kalite.xlsm]veri!f:f])
TextBox1.Value = ar
TextBox2.Value = aw
TextBox3.Value = ar + aw
End Sub

 

[Levent Menteşoğlu]

Verileri sayısal değişkenlere çevirin. Örneğin,

TextBox1.Value = cdbl(ar) gibi.

 

[serqet]

Özür dilerim anlatamadım galiba tam olarak normalde şuan textboxlara toplamlar geliyor ama daha önce süzme yaparken sadece ilgili sayfadan isim koşulu ile süzüyoduk bende o koşula göre sumif yapmıştım, şimdi süzme işlemine tarih koşuluda gelince benim toplam yanlış çıkıyor yani aynı isim fakat seçtiğim tarih aralığında olmayan değerleride topluyor.

 

[Levent Menteşoğlu]

Aşağıdaki gibi döngünün içinde toplayabilirsiniz.

Private Sub CommandButton5_Click()
Dim ver As Worksheet
If DTPicker2.Enabled = False Then
MsgBox "Tarih Aralığı Seçmediniz..!", 16, "DİKKAT"
Else
Windows("Kalite.xlsm").Visible = True
Set ver = Sheets("veri")
ListBox2.RowSource = Empty
ListBox2.Clear
ListBox2.ColumnCount = 9

For Each isim In ver.Range("D2" & ver.Range("A30000").End(xlUp).Row)
If isim >= DTPicker1 And isim <= DTPicker2 and isim.Offset(0, -2)=listbox1.value Then
liste = ListBox2.ListCount
ListBox2.AddItem
ListBox2.list(liste, 3) = Format(isim, "dd.mm.yyyy")
ListBox2.list(liste, 1) = isim.Offset(0, -2) 'İSİM
ListBox2.list(liste, 0) = isim.Offset(0, -3) 'SIRA NO
ListBox2.list(liste, 2) = isim.Offset(0, -1) 'BİRİM
ListBox2.list(liste, 4) = isim.Offset(0, 1) 'ÇAĞRI
ListBox2.list(liste, 5) = isim.Offset(0, 2) 'MAİL
ar=ar+isim.Offset(0, 1)
aw=aw+isim.Offset(0, 2)
End If
Next
End If
TextBox1.Value = ar
TextBox2.Value = aw
TextBox3.Value = ar + aw
End Sub

 

[serqet]

Allah razı olsun sizden üstadım.