İki Tarih Arası liste

[nurettin42]

Kolay gelsin arkadaşlar
userformda iki TextBox var
LİSTE sayfasında A sutundaki tarihleri TextBox1 ve TextBox2 içindeki tarihlere göre ListBox1 iki tarih arsındaki verileri isteğimi kolona göre çekip DÖKÜMAN sayfasına aktarmasını nasıl yapabilirim.
LİSTE sayfasına sürekli kayıt yapılacak.

[halily]

dilerim işinize yarar
1 - çalışmanıza bir modül ekleyip aşağıdaki kodu yapıştırıp

Kod: Tümünü seç

Sub Filter_VeriCek(BasTrh As Long, BitTrh As Long)
    Dim wsLst As Worksheet
    Dim wsDkm As Worksheet
    Dim tarihSutunu As Range
    Dim sonSatir As Long
    
    ' Sayfaları tanımla
    Set wsLst = ThisWorkbook.Sheets("LİSTE")  
    Set wsDkm = ThisWorkbook.Sheets("DÖKÜMAN")

        ' Son satırı bul
        sonSatir = wsLst.Cells(wsLst.Rows.Count, "A").End(xlUp).Row
        SonStnLst = wsLst.Cells(1, wsLst.Columns.Count).End(xlToLeft).Column
        SonStnDkm = wsDkm.Cells(1, wsDkm.Columns.Count).End(xlToLeft).Column

dzLst = wsLst.Range(wsLst.Cells(1, 1), wsLst.Cells(1, SonStnLst)).Value2
dzDkm = wsDkm.Range(wsDkm.Cells(1, 1), wsDkm.Cells(1, SonStnDkm)).Value2
        wsDkm.UsedRange.ClearContents
        
        ' Otomatik filtre uygula
        With wsLst
            .Range("A1").AutoFilter Field:=1, Criteria1:=">=" & BasTrh, Operator:=xlAnd, Criteria2:="<=" & BitTrh
            .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Destination:=wsDkm.Range("A1") 'kopyala
            .AutoFilterMode = False
        End With
For xL = LBound(dzLst, 2) To UBound(dzLst, 2)
    For xD = LBound(dzDkm, 2) To UBound(dzDkm, 2)
        If dzLst(1, xL) = dzDkm(1, xD) Then dzLst(1, xL) = ""
    Next xD
Next xL
    
    For xD = UBound(dzLst, 2) To LBound(dzLst, 2) Step -1
        If dzLst(1, xD) <> "" Then wsDkm.Columns(xD).EntireColumn.Delete
    Next xD
        MsgBox "Filtrelenmiş veriler 'Döküman' sayfasına aktarıldı.", vbInformation

End Sub

2 - "aylık döküman" düğmesinin kodunu da aşağıdaki gibi düzenleyerek dener misiniz?

Kod: Tümünü seç

Private Sub CommandButton1_Click()
    Dim BasTrh As Long
    Dim BitTrh As Long

    ' Tarih girişlerini kontrol et
    If Not IsDate(TextBox1.Value) Or Not IsDate(TextBox2.Value) Then
        MsgBox "Lütfen geçerli bir tarih girin.", vbExclamation
        Exit Sub
    End If

    BasTrh = CLng(CDate(TextBox1.Value))
    BitTrh = CLng(CDate(TextBox2.Value))
    Filter_VeriCek BasTrh, BitTrh
End Sub

[nurettin42]

halily çok teşekkür ederim gtam istediğim gibi olmuş

[halily]

Rica ederim
İyi çalışmalar)

[nurettin42]

halily bey textbox2 textbox1 den küçük olamaz uyarısı olursa çok makbule geçer

[halily]

Kod: Tümünü seç

If Not IsDate(TextBox1.Value) Or Not IsDate(TextBox2.Value) Then
        MsgBox "Lütfen geçerli bir tarih girin.", vbExclamation
        Exit Sub
    Else if TextBox1.value >TextBox2.Value tren
            MsgBox "başlangıç tarihi, bitiş tarihinden büyük olamaz.", vbExclamation
        Exit Sub
    End If

denemedim ama kabaca böyle olabilir.
Telefondan yazdığım için hatalı yazılmış olabilir

[nurettin42]

halily bey allah razı olsun

[halily]

Rica ederim
İyi çalışmalar)