Filtre

S

sedat2161

Katılım
1 Ekim 2017
Mesajlar
694
Excel Vers. ve Dili
2019 türkçe
Altın Üyelik Bitiş Tarihi
06/10/2023
Hayırlı sabahlar arkadaşlar. Ekte gönderdiğim dosyamda Textbox 3 ile arama yaptığımda sorun çıkmıyor. Textbox 4 ile arama yaptığımda Sıra numarası kayboluyor.
 

Ekli dosyalar

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,070
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Listboxa verileri aradığınız sütundan itibaren yerleştiriyorsunuz. Halbuki sıra numarası aradığınız sütundan bir önceki sütunda.

Textbox4 Change kodlarını aşağıdakiyle değiştirerek deneyin:

PHP: 
Private Sub TextBox4_Change()
With ListBox1
    .RowSource = Empty
    .Clear
    For Each evn In Range("C8:C" & Range("C65536").End(3).Row)
        If UCase(LCase(evn)) Like UCase(LCase(TextBox4.Text)) & "*" Then
            osma = .ListCount
            .AddItem
            .List(osma, 0) = evn.Offset(0, -1)
            .List(osma, 1) = evn
            .List(osma, 2) = evn.Offset(0, 1)
            .List(osma, 3) = evn.Offset(0, 2)
            .List(osma, 4) = evn.Offset(0, 3)
            .List(osma, 5) = evn.Offset(0, 4)
        End If
    Next
End With
End Sub
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,401
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Formda çok fazla gereksiz ve düzensiz kod var.
Fomdaki bütün kodları silin aşağıdakileri ekleyin.

Kod: 
Private Sub ComboBox1_Change()
    MsgBox Ay & " YENİ AY İÇİN PUANTAJ OLUŞTURULACAK"
    MsgBox Ay & " BİLGİ VE PUANTAJ SAYFALARINDAKİ BİLGİLER SİLİNECEKTİR"
    Sheets("BİLGİ").Range("F3:l69").ClearContents
    Sheets("PUANTAJ").Range("AU11:AX77").ClearContents
    Sheets("PUANTAJ").Range("F11:H77").ClearContents
    Sheets("PUANTAJ").[AW5] = ComboBox1
End Sub

Private Sub UserForm_Initialize()
    Dim Sons As Long
    ListBox1.ColumnHeads = True
    ListBox1.ColumnCount = 8
    Sons = Sheets("PUANTAJ").Range("B" & Rows.Count).End(xlUp).Row
    ListBox1.RowSource = "PUANTAJ!B10:H" & Sons
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            sedat.TextBox1 = ListBox1.Column(0, i)
            sedat.TextBox2 = ListBox1.Column(1, i)
        End If
    Next i
End Sub
Private Sub Güncelle_Click()
    Dim Onay As Byte, Bul As Range
    Onay = MsgBox("Verileri güncellemek istiyor musunuz?", vbCritical + vbYesNo)
    If Onay = vbNo Then Exit Sub
    Set Bul = Sheets("PUANTAJ").Range("B:B").Find(ListBox1.Column(0), , , xlWhole)
    If Not Bul Is Nothing Then
        Bul.Offset(0, 0) = TextBox1
        Bul.Offset(0, 1) = TextBox2
        MsgBox "Veriler güncellenmiştir.", vbInformation
    End If
End Sub

Private Sub Kaydet_Çık_Click()
    Dim s, Dosya_Yolu As String
    Dosya_Yolu = ThisWorkbook.Path & "\"
    ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "Verilerinizi kaydedip mi çıkmak istiyorsunuz?wav"")")
    cevap = MsgBox("Verilerinizi kaydedip mi çıkmak istiyorsunuz? ", vbYesNoCancel, "")
    If cevap = vbCancel Then Exit Sub
    If cevap = vbNo Then ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "ding.wav"")")
    ActiveWorkbook.Saved = True
    Application.Quit
    If cevap = vbYes Then
        ActiveWorkbook.Save
        cevap = MsgBox("Verileriniz başarıyla kaydedildi, tebrikler:)) ", vbYes, "")
        Application.Quit
    End If
End Sub
Private Sub Temizle_Click()
    Dim txt As Control
    For Each txt In Me.Controls
        If TypeName(txt) = "TextBox" Then txt.Value = ""
    Next
End Sub

Private Sub Tarih(txt As TextBox)
    With txt
        If Len(txt.Value) = 8 Then
            gun = Left(.Value, 2)
            Ay = Mid(.Value, 3, 2)
            sene = Mid(.Value, 5, 4)
            .Value = gun & "." & Ay & "." & sene
        End If
    End With
End Sub

Private Sub TextBox1_Change()
    Tarih TextBox1
End Sub

Private Sub TextBox2_Change()
    Tarih TextBox2
End Sub

Private Sub TextBox3_Change()
    FiltreYap TextBox3.Text, "B"
End Sub

Private Sub TextBox4_Change()
    FiltreYap TextBox4.Text, "C"
End Sub

Private Sub FiltreYap(Aranan As String, KolonHarfi As String)
    Dim evn As Range
    Dim Osma As Integer
    With ListBox1
        .RowSource = Empty
        .Clear
        For Each evn In Range(KolonHarfi & "10:" & KolonHarfi & Range(KolonHarfi & Rows.Count).End(3).Row)
            If UCase(LCase(evn)) Like UCase(LCase(Aranan)) & "*" Then
                Osma = .ListCount
                .AddItem
                .List(Osma, 0) = Cells(evn.Row, "B")
                .List(Osma, 1) = Cells(evn.Row, "C")
                .List(Osma, 2) = Cells(evn.Row, "D")
                .List(Osma, 3) = Cells(evn.Row, "E")
                .List(Osma, 4) = Cells(evn.Row, "F")
                .List(Osma, 5) = Cells(evn.Row, "G")
            End If
        Next
    End With
End Sub
 
S

sedat2161

Katılım
1 Ekim 2017
Mesajlar
694
Excel Vers. ve Dili
2019 türkçe
Altın Üyelik Bitiş Tarihi
06/10/2023
YUSUF44' Alıntı:
Listboxa verileri aradığınız sütundan itibaren yerleştiriyorsunuz. Halbuki sıra numarası aradığınız sütundan bir önceki sütunda.

Textbox4 Change kodlarını aşağıdakiyle değiştirerek deneyin:

PHP: 
Private Sub TextBox4_Change()
With ListBox1
    .RowSource = Empty
    .Clear
    For Each evn In Range("C8:C" & Range("C65536").End(3).Row)
        If UCase(LCase(evn)) Like UCase(LCase(TextBox4.Text)) & "*" Then
            osma = .ListCount
            .AddItem
            .List(osma, 0) = evn.Offset(0, -1)
            .List(osma, 1) = evn
            .List(osma, 2) = evn.Offset(0, 1)
            .List(osma, 3) = evn.Offset(0, 2)
            .List(osma, 4) = evn.Offset(0, 3)
            .List(osma, 5) = evn.Offset(0, 4)
        End If
    Next
End With
End Sub
Genişletmek için tıkla ...
Çok teşekkür ederim. emeğinize sağlık
 
S

sedat2161

Katılım
1 Ekim 2017
Mesajlar
694
Excel Vers. ve Dili
2019 türkçe
Altın Üyelik Bitiş Tarihi
06/10/2023
dalgalikur' Alıntı:
Merhaba.
Formda çok fazla gereksiz ve düzensiz kod var.
Fomdaki bütün kodları silin aşağıdakileri ekleyin.

Kod: 
Private Sub ComboBox1_Change()
    MsgBox Ay & " YENİ AY İÇİN PUANTAJ OLUŞTURULACAK"
    MsgBox Ay & " BİLGİ VE PUANTAJ SAYFALARINDAKİ BİLGİLER SİLİNECEKTİR"
    Sheets("BİLGİ").Range("F3:l69").ClearContents
    Sheets("PUANTAJ").Range("AU11:AX77").ClearContents
    Sheets("PUANTAJ").Range("F11:H77").ClearContents
    Sheets("PUANTAJ").[AW5] = ComboBox1
End Sub

Private Sub UserForm_Initialize()
    Dim Sons As Long
    ListBox1.ColumnHeads = True
    ListBox1.ColumnCount = 8
    Sons = Sheets("PUANTAJ").Range("B" & Rows.Count).End(xlUp).Row
    ListBox1.RowSource = "PUANTAJ!B10:H" & Sons
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            sedat.TextBox1 = ListBox1.Column(0, i)
            sedat.TextBox2 = ListBox1.Column(1, i)
        End If
    Next i
End Sub
Private Sub Güncelle_Click()
    Dim Onay As Byte, Bul As Range
    Onay = MsgBox("Verileri güncellemek istiyor musunuz?", vbCritical + vbYesNo)
    If Onay = vbNo Then Exit Sub
    Set Bul = Sheets("PUANTAJ").Range("B:B").Find(ListBox1.Column(0), , , xlWhole)
    If Not Bul Is Nothing Then
        Bul.Offset(0, 0) = TextBox1
        Bul.Offset(0, 1) = TextBox2
        MsgBox "Veriler güncellenmiştir.", vbInformation
    End If
End Sub

Private Sub Kaydet_Çık_Click()
    Dim s, Dosya_Yolu As String
    Dosya_Yolu = ThisWorkbook.Path & "\"
    ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "Verilerinizi kaydedip mi çıkmak istiyorsunuz?wav"")")
    cevap = MsgBox("Verilerinizi kaydedip mi çıkmak istiyorsunuz? ", vbYesNoCancel, "")
    If cevap = vbCancel Then Exit Sub
    If cevap = vbNo Then ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "ding.wav"")")
    ActiveWorkbook.Saved = True
    Application.Quit
    If cevap = vbYes Then
        ActiveWorkbook.Save
        cevap = MsgBox("Verileriniz başarıyla kaydedildi, tebrikler:)) ", vbYes, "")
        Application.Quit
    End If
End Sub
Private Sub Temizle_Click()
    Dim txt As Control
    For Each txt In Me.Controls
        If TypeName(txt) = "TextBox" Then txt.Value = ""
    Next
End Sub

Private Sub Tarih(txt As TextBox)
    With txt
        If Len(txt.Value) = 8 Then
            gun = Left(.Value, 2)
            Ay = Mid(.Value, 3, 2)
            sene = Mid(.Value, 5, 4)
            .Value = gun & "." & Ay & "." & sene
        End If
    End With
End Sub

Private Sub TextBox1_Change()
    Tarih TextBox1
End Sub

Private Sub TextBox2_Change()
    Tarih TextBox2
End Sub

Private Sub TextBox3_Change()
    FiltreYap TextBox3.Text, "B"
End Sub

Private Sub TextBox4_Change()
    FiltreYap TextBox4.Text, "C"
End Sub

Private Sub FiltreYap(Aranan As String, KolonHarfi As String)
    Dim evn As Range
    Dim Osma As Integer
    With ListBox1
        .RowSource = Empty
        .Clear
        For Each evn In Range(KolonHarfi & "10:" & KolonHarfi & Range(KolonHarfi & Rows.Count).End(3).Row)
            If UCase(LCase(evn)) Like UCase(LCase(Aranan)) & "*" Then
                Osma = .ListCount
                .AddItem
                .List(Osma, 0) = Cells(evn.Row, "B")
                .List(Osma, 1) = Cells(evn.Row, "C")
                .List(Osma, 2) = Cells(evn.Row, "D")
                .List(Osma, 3) = Cells(evn.Row, "E")
                .List(Osma, 4) = Cells(evn.Row, "F")
                .List(Osma, 5) = Cells(evn.Row, "G")
            End If
        Next
    End With
End Sub
Genişletmek için tıkla ...
Çok teşekkür ederim. emeğinize sağlık
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst