Soru Arama koduna 2 tarih arası ekleme

Cengizhantr06

Cengizhantr06

Altın Üye
Katılım
16 Mayıs 2020
Mesajlar
301
Excel Vers. ve Dili
Office 365 Türkçe
Altın Üyelik Bitiş Tarihi
18-05-2025
Tarih g sütünunda ve textbox2 ilk tarih textbox3 son tarih olacak arama koduna ekleyebilirmiyiz
Option Explicit

Sub Listele()
Dim Son As Long, Veri As Variant, X As Long, Say As Long

Son = Cells(Rows.Count, 1).End(xlUp).Row
If Son < 3 Then Son = 3

Veri = Range("A2:G" & Son).Value

With UserForm2.ListView1
.ListItems.Clear
For X = LBound(Veri, 1) To UBound(Veri, 1)
.ListItems.Add , , Veri(X, 1)
Say = Say + 1
With .ListItems(Say).ListSubItems
.Add , , Veri(X, 2)
.Add , , Veri(X, 3)
.Add , , Veri(X, 4)
.Add , , Veri(X, 5)
.Add , , Veri(X, 6)
.Add , , Veri(X, 7)
.Add , , Say
End With
Next
End With
End Sub

Private Sub TextBox1_Change()
Dim Veri As Variant, X As Long, Son As Long, Aranan As String, Say As Long

Application.ScreenUpdating = 0

If TextBox1 <> "" Then
Son = Cells(Rows.Count, 1).End(3).Row
If Son < 3 Then Son = 3
Veri = Range("A2:G" & Son).Value
Aranan = UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ")) & "*"
With UserForm2.ListView1
.ListItems.Clear
For X = LBound(Veri, 1) To UBound(Veri, 1)
If UCase(Replace(Replace(Veri(X, 2), "ı", "I"), "i", "İ")) Like Aranan Then
.ListItems.Add , , Veri(X, 1)
Say = Say + 1
With .ListItems(Say).ListSubItems
.Add , , Veri(X, 2)
.Add , , Veri(X, 3)
.Add , , Veri(X, 4)
.Add , , Veri(X, 5)
.Add , , Veri(X, 6)
.Add , , Veri(X, 7)
.Add , , Say
End With
End If
Next
End With

If Say = 0 Then
Listele
MsgBox "Aranan veri bulunamadı!" & vbLf & vbLf & "Aranan : " & TextBox1, vbExclamation
TextBox1 = ""
End If
Else
Listele
End If

Application.ScreenUpdating = 1
End Sub

Private Sub UserForm_Initialize()
Listele
End Sub
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,333
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Forumda kod paylaşırken mesaj yazdığınız pencerede bulunan üç nokta (...) menüsünü kullanarak eklerseniz daha okunaklı ve düzenli görünecektir.

Deneyiniz.

C++: 
Option Explicit

Sub Listele()
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
   
    If TextBox2 = "" Then
        MsgBox "Lütfen ilk tarihi giriniz!", vbCritical
        TextBox2.SetFocus
        Exit Sub
    Else
        If Not IsDate(TextBox2) Then
            MsgBox "Lütfen tarih giriniz!", vbCritical
            TextBox2 = ""
            TextBox2.SetFocus
            Exit Sub
        End If
    End If
   
    If TextBox3 = "" Then
        MsgBox "Lütfen son tarihi giriniz!", vbCritical
        TextBox3.SetFocus
        Exit Sub
    Else
        If Not IsDate(TextBox3) Then
            MsgBox "Lütfen tarih giriniz!", vbCritical
            TextBox3 = ""
            TextBox3.SetFocus
            Exit Sub
        End If
    End If
   
    If CDate(TextBox2) > CDate(TextBox3) Then
        MsgBox "İlk tarih son tarihten büyük olmamalıdır!", vbCritical
        TextBox2 = ""
        TextBox3 = ""
        TextBox2.SetFocus
        Exit Sub
    End If
   
    Son = Cells(Rows.Count, 1).End(xlUp).Row
    If Son < 3 Then Son = 3
   
    Veri = Range("A2:G" & Son).Value
   
    With UserForm2.ListView1
        .ListItems.Clear
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If Veri(X, 7) >= CDate(TextBox2) And Veri(X, 7) <= CDate(TextBox3) Then
                .ListItems.Add , , Veri(X, 1)
                Say = Say + 1
                With .ListItems(Say).ListSubItems
                    .Add , , Veri(X, 2)
                    .Add , , Veri(X, 3)
                    .Add , , Veri(X, 4)
                    .Add , , Veri(X, 5)
                    .Add , , Veri(X, 6)
                    .Add , , Veri(X, 7)
                    .Add , , Say
                End With
            End If
        Next
    End With
End Sub
C++: 
Private Sub TextBox1_Change()
    Dim Veri As Variant, X As Long, Son As Long, Aranan As String, Say As Long
    
    If TextBox2 = "" Then
        MsgBox "Lütfen ilk tarihi giriniz!", vbCritical
        TextBox2.SetFocus
        Exit Sub
    Else
        If Not IsDate(TextBox2) Then
            MsgBox "Lütfen tarih giriniz!", vbCritical
            TextBox2 = ""
            TextBox2.SetFocus
            Exit Sub
        End If
    End If
    
    If TextBox3 = "" Then
        MsgBox "Lütfen son tarihi giriniz!", vbCritical
        TextBox3.SetFocus
        Exit Sub
    Else
        If Not IsDate(TextBox3) Then
            MsgBox "Lütfen tarih giriniz!", vbCritical
            TextBox3 = ""
            TextBox3.SetFocus
            Exit Sub
        End If
    End If
    
    If CDate(TextBox2) > CDate(TextBox3) Then
        MsgBox "İlk tarih son tarihten büyük olmamalıdır!", vbCritical
        TextBox2 = ""
        TextBox3 = ""
        TextBox2.SetFocus
        Exit Sub
    End If
    
    Application.ScreenUpdating = 0
    
    If TextBox1 <> "" Then
        Son = Cells(Rows.Count, 1).End(3).Row
        If Son < 3 Then Son = 3
        Veri = Range("A2:G" & Son).Value
        Aranan = UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ")) & "*"
        With UserForm2.ListView1
            .ListItems.Clear
            For X = LBound(Veri, 1) To UBound(Veri, 1)
                If Veri(X, 7) >= CDate(TextBox2) And Veri(X, 7) <= CDate(TextBox3) Then
                    If UCase(Replace(Replace(Veri(X, 2), "ı", "I"), "i", "İ")) Like Aranan Then
                        .ListItems.Add , , Veri(X, 1)
                        Say = Say + 1
                        With .ListItems(Say).ListSubItems
                            .Add , , Veri(X, 2)
                            .Add , , Veri(X, 3)
                            .Add , , Veri(X, 4)
                            .Add , , Veri(X, 5)
                            .Add , , Veri(X, 6)
                            .Add , , Veri(X, 7)
                            .Add , , Say
                        End With
                    End If
                End If
            Next
        End With
        
        If Say = 0 Then
            Listele
            MsgBox "Aranan veri bulunamadı!" & vbLf & vbLf & "Aranan : " & TextBox1, vbExclamation
            TextBox1 = ""
        End If
    Else
        Listele
    End If
    
    Application.ScreenUpdating = 1
End Sub
 
Cengizhantr06

Cengizhantr06

Altın Üye
Katılım
16 Mayıs 2020
Mesajlar
301
Excel Vers. ve Dili
Office 365 Türkçe
Altın Üyelik Bitiş Tarihi
18-05-2025
Korhan Ayhan' Alıntı:
Forumda kod paylaşırken mesaj yazdığınız pencerede bulunan üç nokta (...) menüsünü kullanarak eklerseniz daha okunaklı ve düzenli görünecektir.

Deneyiniz.

C++: 
Option Explicit

Sub Listele()
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
  
    If TextBox2 = "" Then
        MsgBox "Lütfen ilk tarihi giriniz!", vbCritical
        TextBox2.SetFocus
        Exit Sub
    Else
        If Not IsDate(TextBox2) Then
            MsgBox "Lütfen tarih giriniz!", vbCritical
            TextBox2 = ""
            TextBox2.SetFocus
            Exit Sub
        End If
    End If
  
    If TextBox3 = "" Then
        MsgBox "Lütfen son tarihi giriniz!", vbCritical
        TextBox3.SetFocus
        Exit Sub
    Else
        If Not IsDate(TextBox3) Then
            MsgBox "Lütfen tarih giriniz!", vbCritical
            TextBox3 = ""
            TextBox3.SetFocus
            Exit Sub
        End If
    End If
  
    If CDate(TextBox2) > CDate(TextBox3) Then
        MsgBox "İlk tarih son tarihten büyük olmamalıdır!", vbCritical
        TextBox2 = ""
        TextBox3 = ""
        TextBox2.SetFocus
        Exit Sub
    End If
  
    Son = Cells(Rows.Count, 1).End(xlUp).Row
    If Son < 3 Then Son = 3
  
    Veri = Range("A2:G" & Son).Value
  
    With UserForm2.ListView1
        .ListItems.Clear
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If Veri(X, 7) >= CDate(TextBox2) And Veri(X, 7) <= CDate(TextBox3) Then
                .ListItems.Add , , Veri(X, 1)
                Say = Say + 1
                With .ListItems(Say).ListSubItems
                    .Add , , Veri(X, 2)
                    .Add , , Veri(X, 3)
                    .Add , , Veri(X, 4)
                    .Add , , Veri(X, 5)
                    .Add , , Veri(X, 6)
                    .Add , , Veri(X, 7)
                    .Add , , Say
                End With
            End If
        Next
    End With
End Sub
C++: 
Private Sub TextBox1_Change()
    Dim Veri As Variant, X As Long, Son As Long, Aranan As String, Say As Long
   
    If TextBox2 = "" Then
        MsgBox "Lütfen ilk tarihi giriniz!", vbCritical
        TextBox2.SetFocus
        Exit Sub
    Else
        If Not IsDate(TextBox2) Then
            MsgBox "Lütfen tarih giriniz!", vbCritical
            TextBox2 = ""
            TextBox2.SetFocus
            Exit Sub
        End If
    End If
   
    If TextBox3 = "" Then
        MsgBox "Lütfen son tarihi giriniz!", vbCritical
        TextBox3.SetFocus
        Exit Sub
    Else
        If Not IsDate(TextBox3) Then
            MsgBox "Lütfen tarih giriniz!", vbCritical
            TextBox3 = ""
            TextBox3.SetFocus
            Exit Sub
        End If
    End If
   
    If CDate(TextBox2) > CDate(TextBox3) Then
        MsgBox "İlk tarih son tarihten büyük olmamalıdır!", vbCritical
        TextBox2 = ""
        TextBox3 = ""
        TextBox2.SetFocus
        Exit Sub
    End If
   
    Application.ScreenUpdating = 0
   
    If TextBox1 <> "" Then
        Son = Cells(Rows.Count, 1).End(3).Row
        If Son < 3 Then Son = 3
        Veri = Range("A2:G" & Son).Value
        Aranan = UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ")) & "*"
        With UserForm2.ListView1
            .ListItems.Clear
            For X = LBound(Veri, 1) To UBound(Veri, 1)
                If Veri(X, 7) >= CDate(TextBox2) And Veri(X, 7) <= CDate(TextBox3) Then
                    If UCase(Replace(Replace(Veri(X, 2), "ı", "I"), "i", "İ")) Like Aranan Then
                        .ListItems.Add , , Veri(X, 1)
                        Say = Say + 1
                        With .ListItems(Say).ListSubItems
                            .Add , , Veri(X, 2)
                            .Add , , Veri(X, 3)
                            .Add , , Veri(X, 4)
                            .Add , , Veri(X, 5)
                            .Add , , Veri(X, 6)
                            .Add , , Veri(X, 7)
                            .Add , , Say
                        End With
                    End If
                End If
            Next
        End With
       
        If Say = 0 Then
            Listele
            MsgBox "Aranan veri bulunamadı!" & vbLf & vbLf & "Aranan : " & TextBox1, vbExclamation
            TextBox1 = ""
        End If
    Else
        Listele
    End If
   
    Application.ScreenUpdating = 1
End Sub
Genişletmek için tıkla ...
Çok teşekkür ederim Korhan bey
 
Cengizhantr06

Cengizhantr06

Altın Üye
Katılım
16 Mayıs 2020
Mesajlar
301
Excel Vers. ve Dili
Office 365 Türkçe
Altın Üyelik Bitiş Tarihi
18-05-2025
@Korhan Ayhan hocam şöyle bir değişim yapabilirmiyiz 1.ilk formu açınca yine tüm listeyi göstersin 2.eğer tarih kısımları boş ise yine isim ile arama yapsın egerki ilk tarih dolu ise ikinci boş ise ilk tarihten sonra olanları göstersin yada ilk tarih boş son tarih dolu ise son tarihe olanları göstersin yada iki tarihte dolu ise ikisinin arasını göstersin size zahmet
 

Ekli dosyalar

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,333
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Sorunuz iki tarih arası koşulunun eklenmesiydi. Bu koşulu eklediğimi düşünüyorum. Diğer geliştirmeleri kendiniz yapmalısınız.
 
Cengizhantr06

Cengizhantr06

Altın Üye
Katılım
16 Mayıs 2020
Mesajlar
301
Excel Vers. ve Dili
Office 365 Türkçe
Altın Üyelik Bitiş Tarihi
18-05-2025
Sizde haklısınız sağolun
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst