Gelişmiş filtre tarih aralığı

[bunyaming]

Merhaba,

Eklediğim listede ki tarih aralığını filtre yapamıyorum.

bu listeye bağlı her türlü ortalamayı ve analizleri yapıyorum fakat tarih aralıklı sorgular da pivot kullanmadan bu liste üzerinden sonuçlandırmam gerekiyor.

yardımlarınızı rica ediyorum.

 

[SERHAT1634]

Dim veriler(10000, 8)
Dim verisay As Long
Public doviz1, doviz2, doviz3, doviz4 As String

Sub menu()
Application.ScreenUpdating = False
Call verileri_al
Call verileri_yaz
Call Baslik_Bicimle
Application.ScreenUpdating = True
MsgBox ("Rapor Tamamlandı ! ")
[A1].Select
End Sub

Sub Baslik_Bicimle()
sonsatir = Cells(Rows.Count, "B").End(3).Row + 1
Range("B9:G9").Select
Selection.Copy
secim = "B" & sonsatir & ":H" & sonsatir
Range(secim).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("G9").Select
Selection.Copy
Range("H9").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("H9").Select
ActiveCell.FormulaR1C1 = "DÖVİZ"
Range("B" & sonsatir).Select
ActiveCell.FormulaR1C1 = "TOPLAM"
cercevele ("B10:H" & sonsatir)
Range("B25").Select
End Sub


Sub verileri_yaz()
Sheets("AnaTablo").Select

sonsatir = Cells(Rows.Count, "B").End(3).Row
If sonsatir = 9 Then sonsatir = 10
secim = "10:" & sonsatir
Rows(secim).Select
Selection.Delete Shift:=xlUp
Range("B10").Select

For j = 1 To verisay
Cells(j + 9, 2) = veriler(j, 1)
Cells(j + 9, 3) = veriler(j, 3)
Cells(j + 9, 4) = veriler(j, 5)
Cells(j + 9, 5) = veriler(j, 6)
Cells(j + 9, 6) = veriler(j, 7)
Cells(j + 9, 7) = veriler(j, 8)
Cells(j + 9, 8) = veriler(j, 2)
Next j

sonsatir = Cells(Rows.Count, "B").End(3).Row + 1
formul = "=SUM(R[-" & verisay & "]C:R[-1]C)"
Cells(sonsatir, 5).Select
ActiveCell.FormulaR1C1 = formul
Cells(sonsatir, 6).Select
ActiveCell.FormulaR1C1 = formul
Cells(sonsatir, 7).Select
ActiveCell.FormulaR1C1 = formul

End Sub

Sub verileri_al()
Sheets("AnaTablo").Select
If Sheets("AnaTablo").CheckBox1.Value Then doviz1 = "TL" Else doviz1 = ""
If Sheets("AnaTablo").CheckBox2.Value Then doviz2 = "USD" Else doviz2 = ""
If Sheets("AnaTablo").CheckBox3.Value Then doviz3 = "EURO" Else doviz3 = ""
If Sheets("AnaTablo").CheckBox4.Value Then doviz4 = "DIGER" Else doviz4 = ""

tarih1 = CDate([D1])
tarih2 = CDate([D2])
'doviz1 = [C3]
'doviz2 = [C4]
verisay = 0
For i = 2 To Sheets.Count
Sheets(i).Select
sonsatir = Cells(Rows.Count, "A").End(3).Row
For j = 2 To sonsatir
banka = Cells(j, 1)
doviz = Cells(j, 2)
referans = Cells(j, 3)
tahsis = Cells(j, 4)
vade = CDate(Cells(j, 5))
taksit = Cells(j, 6)
anapara = Cells(j, 7)
faiz = Cells(j, 8)
If vade >= tarih1 And vade <= tarih2 And _
((doviz = doviz1 Or doviz = doviz2 Or doviz = doviz3) Or _
(doviz4 = "DIGER" And (doviz <> "TL" And doviz <> "USD" And doviz <> "EURO"))) Then
verisay = verisay + 1
veriler(verisay, 1) = banka
veriler(verisay, 2) = doviz
veriler(verisay, 3) = referans
veriler(verisay, 4) = tahsis
veriler(verisay, 5) = vade
veriler(verisay, 6) = taksit
veriler(verisay, 7) = anapara
veriler(verisay, 8) = faiz
End If
Next j
Next i

End Sub

Sub cercevele(secim As String)
Range(secim).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("B9").Select
End Sub

 

[bunyaming]

hızlı cevabınız için teşekkür ediyorum,yalnız verdiğiniz kodları çözemedim.
onun yerine rica etsem gönderdiğim tabloya uyarlama şansınız varmı ek olarak geri gönderseniz çokmu masraflı olurum

 

[bunyaming]

Değerli Üstadlarım,

yardımcı olabilirmisiniz?