• DİKKAT

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

iki tarih arası süzme

R

ridvan2111

Katılım
14 Ekim 2007
Mesajlar
173
Excel Vers. ve Dili
xp tr
Selam arkadaşlar.

Sayın Evren Gizlenin katkılarıyla ve excel web tr den edindiğim bilgilerle hazırlamış olduğum çalışmada son bir eksiğim kaldı.

çalışmadaki userformda mevcut süzme kodlarına ilave olarak iki tarih arasında süzme ilave etmek istiyorum.

1. ilk tarih textbox12
2. son tarih textbox13

tarihler "L" sutununda

form açılışında texboxs 12 ye en küçük tarih
textboxs 13 e en büyük tarih gelirse iyi olur.

bu iki bax mevcut süzme bax larına ilave olacak. bu konuda yardımlarınızı bekliyorum.
 

Ekli dosyalar

Syn. Rıdvan2111;
Private Sub UserForm_Initialize Kodunun sonuna aşğıdaki satırları ekleyin
Ekteki örnek dosyayı inceleyin.
Kod: 
TextBox12.Text = WorksheetFunction.Min(Range("L:L"))
TextBox12.Value = Format(TextBox12.Value, "dd.mm.yyyy")
TextBox13.Text = WorksheetFunction.Max(Range("L:L"))
TextBox13.Value = Format(TextBox13.Value, "dd.mm.yyyy")
 

Ekli dosyalar

ynmcany' Alıntı:
Syn. Rıdvan2111;
Private Sub UserForm_Initialize Kodunun sonuna aşğıdaki satırları ekleyin
Ekteki örnek dosyayı inceleyin.
Kod: 
TextBox12.Text = WorksheetFunction.Min(Range("L:L"))
TextBox12.Value = Format(TextBox12.Value, "dd.mm.yyyy")
TextBox13.Text = WorksheetFunction.Max(Range("L:L"))
TextBox13.Value = Format(TextBox13.Value, "dd.mm.yyyy")
Genişletmek için tıkla ...

Syn. ynmcany
Teşekkür ederim. Tarihleri baxlar aldık.

Süzme işilemi yardım bekliyor :)
 
Syn. Rıvan2111;
Aşağııdaki Textbox12 kodunu silip
Kod: 
Private Sub TextBox12_Change()
Call suz_61
End Sub
Yerine; 1.tarih - 2.tarih yanına süzme işlemi için bir adet buton ekledim.
Bu butona aşağıdaki kodu yazdım
Kod: 
Private Sub CommandButton13_Click()

If TextBox12.Text = "" Then
MsgBox "1.tarihi giriniz!!!"
Exit Sub
End If
If TextBox13.Text = "" Then
MsgBox "2.tarihi giriniz!!!"
Exit Sub
End If
If CDate(TextBox12.Text) > CDate(TextBox13.Text) Then
MsgBox "2.tarih 1. tarihten küçük olmaz!!!"
Exit Sub
End If
Call suz_61

End Sub

Ayrıca Sub suz_61 macrosuna kırmızı ile belirtiğim satırıları silip, mavi ile belirtiğim satırları ekledim.

Kod: 
Sub suz_61()
    Dim i As Long, aaaa, bbbb, cccc, dddd, eeee, ffff, gggg, hhhh, ıııı, jjjj, kkkk, llll, mmmm, nnnn As String
Set sr = Sheets("desen bilgileri")
ListView1.ListItems.Clear
With ListView1

For i = 3 To sr.Cells(65536, "B").End(xlUp).Row

    
    If TextBox1.Value = "" Then
        aaaa = sr.Cells(i, "A").Value
        Else
        aaaa = TextBox1.Value
    End If
    
    If TextBox2.Value = "" Then
        bbbb = sr.Cells(i, "B").Value
        Else
        bbbb = TextBox2.Value
    End If
    
    If TextBox3.Value = "" Then
        cccc = sr.Cells(i, "C").Value
        Else
        cccc = TextBox3.Value
    End If
    
    If TextBox4.Value = "" Then
        dddd = sr.Cells(i, "D").Value
        Else
        dddd = TextBox4.Value
    End If

    If TextBox5.Value = "" Then
        eeee = sr.Cells(i, "E").Value
        Else
        eeee = TextBox5.Value
    End If

    If TextBox6.Value = "" Then
        ffff = sr.Cells(i, "F").Value
        Else
        ffff = TextBox6.Value
    End If
    
    If TextBox7.Value = "" Then
        gggg = sr.Cells(i, "G").Value
        Else
        gggg = TextBox7.Value
    End If
    
        If TextBox8.Value = "" Then
        hhhh = sr.Cells(i, "H").Value
        Else
        hhhh = TextBox8.Value
    End If
    
        If TextBox9.Value = "" Then
        ıııı = sr.Cells(i, "I").Value
        Else
        ıııı = TextBox9.Value
    End If
    
        If TextBox10.Value = "" Then
        jjjj = sr.Cells(i, "J").Value
        Else
        jjjj = TextBox10.Value
    End If
    
        If TextBox11.Value = "" Then
        kkkk = sr.Cells(i, "K").Value
        Else
        kkkk = TextBox11.Value
    End If
    
    [COLOR="Red"]If TextBox12.Value = "" Then
        kkkk = sr.Cells(i, "K").Value
        Else
       llll = TextBox12.Value
    End If[/COLOR] 
    
    aaaa = UCase(Replace(Replace(aaaa, "ı", "I"), "i", "İ"))
    bbbb = UCase(Replace(Replace(bbbb, "ı", "I"), "i", "İ"))
    cccc = UCase(Replace(Replace(cccc, "ı", "I"), "i", "İ"))
    dddd = UCase(Replace(Replace(dddd, "ı", "I"), "i", "İ"))
    eeee = UCase(Replace(Replace(eeee, "ı", "I"), "i", "İ"))
    ffff = UCase(Replace(Replace(ffff, "ı", "I"), "i", "İ"))
    gggg = UCase(Replace(Replace(gggg, "ı", "I"), "i", "İ"))
    hhhh = UCase(Replace(Replace(hhhh, "ı", "I"), "i", "İ"))
    ıııı = UCase(Replace(Replace(ıııı, "ı", "I"), "i", "İ"))
    jjjj = UCase(Replace(Replace(jjjj, "ı", "I"), "i", "İ"))
    kkkk = UCase(Replace(Replace(kkkk, "ı", "I"), "i", "İ"))
    llll = UCase(Replace(Replace(llll, "ı", "I"), "i", "İ"))
    
    
   

    If UCase(Replace(Replace(sr.Cells(i, "A").Value, "ı", "I"), "i", "İ")) Like "*" & aaaa & "*" And UCase(Replace(Replace(sr.Cells(i, "B").Value, "ı", "I"), "i", "İ")) Like "*" & bbbb & "*" And UCase(Replace(Replace(sr.Cells(i, "C").Value, "ı", "I"), "i", "İ")) Like MatchCase & cccc & MatchCase _
    And UCase(Replace(Replace(sr.Cells(i, "D").Value, "ı", "I"), "i", "İ")) Like "*" & dddd & "*" And UCase(Replace(Replace(sr.Cells(i, "E").Value, "ı", "I"), "i", "İ")) Like "*" & eeee & "*" And UCase(Replace(Replace(sr.Cells(i, "F").Value, "ı", "I"), "i", "İ")) Like "*" & ffff & "*" _
    And UCase(Replace(Replace(sr.Cells(i, "G").Value, "ı", "I"), "i", "İ")) Like "*" & gggg & "*" And UCase(Replace(Replace(sr.Cells(i, "H").Value, "ı", "I"), "i", "İ")) Like "*" & hhhh & "*" And UCase(Replace(Replace(sr.Cells(i, "I").Value, "ı", "I"), "i", "İ")) Like "*" & ıııı & "*" _
    And UCase(Replace(Replace(sr.Cells(i, "J").Value, "ı", "I"), "i", "İ")) Like "*" & jjjj & "*" And UCase(Replace(Replace(sr.Cells(i, "K").Value, "ı", "I"), "i", "İ")) Like "*" & kkkk & "*" And UCase(Replace(Replace(sr.Cells(i, "L").Value, "ı", "I"), "i", "İ")) Like "*" & llll & "*" & "*" Then
 
 
    
[COLOR="Blue"]If sr.Cells(i, "L").Value >= CDate(TextBox12.Text) And sr.Cells(i, "L").Value <= CDate(TextBox13.Text) Then      [/COLOR]        .ListItems.Add , , i
        X = X + 1
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "A")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "B")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "C")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "D")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "E")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "F")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "G")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "H")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "I")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "J")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "K")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "L")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "M")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "N")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "O")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "P")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "Q")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "R")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "S")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "T")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "U")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "V")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "W")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "X")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "Y")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "Z")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AA")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AB")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AC")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AD")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AE")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AF")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AG")
                     
        

End If

End If

Next i

End With
Set sr = Nothing
Exit Sub
    On Error Resume Next
    With Application
            .ScreenUpdating = False
            .EnableEvents = False
    End With
    Set sr = Sheets("toplamlar")
    ListView1.ListItems.Clear
    ListView1.Sorted = False
    Set Alan = sr.Range("B3:B" & sr.[b65536].End(3).Row)
    Set Bul = Alan.Find(deg & "*")
        If Not Bul Is Nothing Then
                Adres = Bul.Address
             Do
                satır = Bul.Row
                With ListView1
                   .ListItems.Add , , sr.Cells(satır, "B")
                    X = X + 1
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "A")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "B")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "C")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "D")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "E")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "F")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "G")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "H")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "I")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "J")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "K")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "L")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "M")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "N")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "O")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "P")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "Q")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "R")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "S")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "T")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "U")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "V")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "W")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "X")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "Y")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "Z")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AA")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AB")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AC")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AD")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AE")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AF")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AG")
                     
                     
                     
                     
            
            
                     
                     
                End With
                Set Bul = Alan.FindNext(Bul)
             Loop While Not Bul Is Nothing And Bul.Address <> Adres
        ListView1.Sorted = True
        ListView1.SortOrder = lvwAscending
        ListView1.SortOrder = 0
        End If
    Set sr = Nothing
    Set Alan = Nothing
    Set Bul = Nothing
    With Application
            .EnableEvents = True
            .ScreenUpdating = True
    End With
End Sub

Ekteki dosyayı inceleyin.
 

Ekli dosyalar

Sn. ynmcany İhtiyacım tam böyle bişeydi teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst