• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

tarihe göre uyarı

Katılım
15 Mart 2010
Mesajlar
244
Excel Vers. ve Dili
2019 Türkçe
Selam arkadaşlar
bitiş tarihine göre userform da uyarı verdirmek mümkünmü şimdiden teşekkürler
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod:
Private Sub CommandButton1_Click()
Dim sh As Worksheet, tar1 As Date, tar2 As Date, sonsat As Long
Set sh = Sheets("Suz")
Sheets("Data").Select
tar1 = TextBox1.Value
tar2 = tar1 + 6
ListBox1.RowSource = ""
sh.Range("A2:D" & Rows.Count).ClearContents
Range("A1").AutoFilter
sonsat = Cells(Rows.Count, "D").End(xlUp).Row
Range("A1").AutoFilter field:=4, Criteria1:=">=" & CLng(tar1), _
        Operator:=xlAnd, Criteria2:="<=" & CLng(tar2)
Range("A1").CurrentRegion.Copy sh.Range("A1")
Range("A1").AutoFilter
sonsat = sh.Cells(Rows.Count, "D").End(xlUp).Row
If sonsat > 1 Then ListBox1.RowSource = "Suz!A2:D" & sonsat
End Sub
 

Ekli dosyalar

istediğim gibi olmuş fakat çok zahmet olmazsa iki tarih arasındakiler diyebilirmiyiz
 
istediğim gibi olmuş fakat çok zahmet olmazsa iki tarih arasındakiler diyebilirmiyiz

Dosyanız ektedir.:cool:
Kod:
Private Sub CommandButton1_Click()
Dim sh As Worksheet, tar1 As Date, tar2 As Date, sonsat As Long
Set sh = Sheets("Suz")
Sheets("Data").Select
tar1 = TextBox1.Value
tar2 = TextBox2.Value
ListBox1.RowSource = ""
sh.Range("A2:D" & Rows.Count).ClearContents
Range("A1").AutoFilter
sonsat = Cells(Rows.Count, "D").End(xlUp).Row
Range("A1").AutoFilter field:=4, Criteria1:=">=" & CLng(tar1), _
        Operator:=xlAnd, Criteria2:="<=" & CLng(tar2)
Range("A1").CurrentRegion.Copy sh.Range("A1")
Range("A1").AutoFilter
sonsat = sh.Cells(Rows.Count, "D").End(xlUp).Row
If sonsat > 1 Then ListBox1.RowSource = "Suz!A2:D" & sonsat
End Sub
 

Ekli dosyalar

Geri
Üst