Hücre Arama Yaparak Filtre

[mukoli]

Merhabalar aşağıdaki kod textbox işlem yapıyor bunu hücrede çalışması için değiştirebilirmiyiz D1 hücresinde . Teşekkürler şimdiden

Private Sub TextBox1_Change()
Dim stok As Worksheet, ara As Worksheet, Tbl()
Dim son As Long, ara_son As Long, x As Long
Set stok = Sheets("MerkezFiyat")
Set ara = Sheets("Stok_Arama")
son = stok.Range("B" & Rows.Count).End(xlUp).Row
Tbl = stok.Range("A2:G" & son).Value
ReDim v(1 To UBound(Tbl), 1 To 7)
    If TextBox1 = "" Then
        ara.[A2].Resize(UBound(Tbl)).NumberFormat = "@"
        ara.[C2].Resize(UBound(Tbl)).NumberFormat = "#,##0.00"
        ara.[A2].Resize(UBound(Tbl), 7).Value = Tbl
        ara.[A2].Resize(UBound(Tbl), 7).Borders.Color = rgbSilver
    Else
        xx = UCase(Replace(Replace(TextBox1, "i", "İ"), "ı", "I"))
        aranan = "*" & xx & "*"
        For x = 1 To UBound(Tbl)
            yy = UCase(Replace(Replace(Tbl(x, 2), "i", "İ"), "ı", "I"))
            If yy Like aranan Then
                say = say + 1
                For j = 1 To 7
                    v(say, j) = Tbl(x, j)
                Next j
            End If
        Next x
        ara_son = ara.Range("B" & Rows.Count).End(xlUp).Row
        ara.Range("A2:G" & ara_son + 1).ClearContents
        ara.Range("A2:G" & ara_son + 1).ClearFormats
        If say > 0 Then
            ara.[A2].Resize(say).NumberFormat = "@"
            ara.[C2].Resize(say).NumberFormat = "#,##0.00"
            ara.[A2].Resize(say, 7) = v
            ara.[A2].Resize(say, 7).Borders.Color = rgbSilver
        End If
    End If
    Sheets("Stok_Arama").Range("A2:G65000").Sort Key1:=Sheets("Stok_Arama").Range("B2")
End Sub

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu sayfanızın kod kısmına kopyalayın.
Eğer herhangi bir sorun yaşar yada çalıştıramazsanız dosyanızı ekleyin kontrol edelim.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D1")) Is Nothing Then
        Dim stok As Worksheet, ara As Worksheet, Tbl()
        Dim son As Long, ara_son As Long, x As Long
        Set stok = Sheets("MerkezFiyat")
        Set ara = Sheets("Stok_Arama")
        son = stok.Range("B" & Rows.Count).End(xlUp).Row
        Tbl = stok.Range("A2:G" & son).Value
        ReDim v(1 To UBound(Tbl), 1 To 7)
            If Target.Text = "" Then
                ara.[A2].Resize(UBound(Tbl)).NumberFormat = "@"
                ara.[C2].Resize(UBound(Tbl)).NumberFormat = "#,##0.00"
                ara.[A2].Resize(UBound(Tbl), 7).Value = Tbl
                ara.[A2].Resize(UBound(Tbl), 7).Borders.Color = rgbSilver
            Else
                xx = UCase(Replace(Replace(Target.Text, "i", "İ"), "ı", "I"))
                aranan = "*" & xx & "*"
                For x = 1 To UBound(Tbl)
                    yy = UCase(Replace(Replace(Tbl(x, 2), "i", "İ"), "ı", "I"))
                    If yy Like aranan Then
                        say = say + 1
                        For j = 1 To 7
                            v(say, j) = Tbl(x, j)
                        Next j
                    End If
                Next x
                ara_son = ara.Range("B" & Rows.Count).End(xlUp).Row
                ara.Range("A2:G" & ara_son + 1).ClearContents
                ara.Range("A2:G" & ara_son + 1).ClearFormats
                If say > 0 Then
                    ara.[A2].Resize(say).NumberFormat = "@"
                    ara.[C2].Resize(say).NumberFormat = "#,##0.00"
                    ara.[A2].Resize(say, 7) = v
                    ara.[A2].Resize(say, 7).Borders.Color = rgbSilver
                End If
            End If
            Sheets("Stok_Arama").Range("A2:G65000").Sort Key1:=Sheets("Stok_Arama").Range("B2")
    End If
End Sub