AccessTr.neT

Webden bir eğitici videodan yararlanarak bir çalışma sayfası hazırladım.

Arama Kutusu Hazırlama Veri Filtreleme örnek dosya üzerinde çeşitli arama yapabilir miyiz?

Checboxlara tıklayınca diğerlerinin tiki kaldırma koduda ekledim.
2021 ve 365 versiyonda çalışır.

(08/11/2023, 00:58)feraz yazdı: [ -> ]Checboxlara tıklayınca diğerlerinin tiki kaldırma koduda ekledim.
2021 ve 365 versiyonda çalışır.

Sayın @feraz bey çok teşekkürler. Güzel ve istediğim gibi olmuş. Elinize sağlık. ihtiyaca cevap verdi.

Rica ederim,kolay gelsin.

Bence mantık hatası olmuş optionbuttonlar ekledim ve kodda kısaldı ayrıca textboxa yazarkende çalışıyor.

Sub AramaYap_Secenekli()

    Dim son As Long, Filtrele, syf As String

    With ThisWorkbook.Sheets("Arama Kutusu Yapma")

        syf = "'" & .Name & "'!"

        .Range("B7:C" & Rows.Count).ClearContents

        son = .Cells(Rows.Count, "E").End(3).Row

        If son < 7 Then Exit Sub



    If ActiveSheet.Shapes("Option Button 6").OLEFormat.Object.Value = 1 Then 'Esitse

            Filtrele = Evaluate("=FILTER(" & syf & "E7:F" & son & "," & syf & "E7:E" & son & "=" & syf & "B4,"""")")



    ElseIf ActiveSheet.Shapes("Option Button 7").OLEFormat.Object.Value = 1 Then 'Baslarsa

            Filtrele = Evaluate("FILTER(" & syf & "E7:F" & son & ",(LEFT(" & syf & "E7:E" & son & "," & _

                                                                  "LEN(""" & .Range("B4").Value & """))=""" & .Range("B4").Value & """))")

                                                                  

    ElseIf ActiveSheet.Shapes("Option Button 8").OLEFormat.Object.Value = 1 Then 'icerirse

            Filtrele = Evaluate("=FILTER(" & syf & "E7:F" & son & ",ISNUMBER(search(" & syf & "B4," & syf & "E7:E" & son & ")))") 

            

    ElseIf ActiveSheet.Shapes("Option Button 9").OLEFormat.Object.Value = 1 Then 'Biterse

        Filtrele = Evaluate("FILTER(" & syf & "E7:F" & son & ",(Right(" & syf & "E7:E" & son & "," & _

                                                                  "LEN(""" & .Range("B4").Value & """))=""" & .Range("B4").Value & """))")

    End If

        

        If IsArray(Filtrele) = False Then Exit Sub

        If UBound(Filtrele) = 2 Then

            .Range("B7").Resize(UBound(Filtrele) - 1, 2).Value = Filtrele

        Else

            .Range("B7").Resize(UBound(Filtrele), 2).Value = Filtrele

        End If

    

  End With

End Sub

Sayın @feraz bey elinize sağlık hem alternatif olmuş hem de kullanışlı olmuş. Çok teşekkür ederim. İhtiyaca cevap verdi.