#1
Arama Kutusu Hazırlama Veri Filtreleme.7z
(Dosya Boyutu: 13,66 KB | İndirme Sayısı: 5)
Arama Kutusu Hazırlama Veri Filtreleme.zip
(Dosya Boyutu: 28,67 KB | İndirme Sayısı: 5)
#3
(08/11/2023, 00:58)feraz yazdı: Checboxlara tıklayınca diğerlerinin tiki kaldırma koduda ekledim.
2021 ve 365 versiyonda çalışır.
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
