Makro İle Textboxda Arama

[mukoli]

Merhaba hocalarım bu kod ta textbox birşey yazmaya başlayınca hata veriyor. .RowSource = "" Bu Satırda Hata veriyor. Object required Hatası Yardımcı olursanız çok sevirim iyi günler dilerim

Private Sub TextBox1_Change()
Dim stok As Worksheet, ara As Worksheet
Dim son As Long, ara_son As Long, x As Long

If TextBox1.Value = "" Then
    lststok.RowSource = ""
    lststok.Clear
    Exit Sub
End If

Set stok = Sheets("MerkezFiyat")
Set ara = Sheets("Stok_Arama")
son = stok.Range("B" & Rows.Count).End(xlUp).Row
ara_son = ara.Range("B" & Rows.Count).End(xlUp).Row
ara.Range("A1:C" & ara_son + 1).Clear

aranan = TextBox1.Value

For x = 2 To son
    If stok.Cells(x, "B").Value Like "*" & aranan & "*" Then
        ara_son = ara.Range("B" & Rows.Count).End(xlUp).Row + 1
        ara.Cells(ara_son, "A").Value = stok.Cells(x, "A").Value
        ara.Cells(ara_son, "B").Value = stok.Cells(x, "B").Value
        ara.Cells(ara_son, "C").Value = stok.Cells(x, "C").Value
    End If
Next

    With lststok
        .RowSource = ""
        .Clear
        .ColumnCount = 2
        .RowSource = "Stok_Arama!A1:C" & ara_son
    End With
End Sub

 

[ÖmerFaruk]

Dosyanızı görmeden yazıyorum.

ColumnCount=2 demişsiniz
"Stok_Arama!A1:C" & ara_son aralığını yani 3 sütun belirtiyorsunuz.

Birisi hatalı olsa gerek.

 

[mukoli]

Dosyanızı görmeden yazıyorum.

ColumnCount=2 demişsiniz
"Stok_Arama!A1:C" & ara_son aralığını yani 3 sütun belirtiyorsunuz.

Birisi hatalı olsa gerek.

Merhaba hocam dosyamı ekledim dediğiniz yeri düzelttim ama yine aynı hatayı verdi

 

[ÖmerFaruk]

sayfanızda lststok öğresi nerede?

 

[mukoli]

Sütundamı olması gerekiyor hocam

 

[ÖmerFaruk]

Cevabımın evet olduğunu varsayabilirsiniz.

 

[mukoli]

Ama hocam yine hata alıyorum ben anlamadım k.bakmayın

 

[ÖmerFaruk]

Açıkçası ben de anlamadım.

 

[mukoli]

Teşekkürler üstadım iyi günler dilerim

 

[mukoli]

Başka yardımcı olucak varmıdır acaba

 

[Ziynettin]

Amacınız sayfaya listelemek ise kodu bu şekilde deneyiniz.

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:C" & son).Value
ReDim v(1 To UBound(Tbl), 1 To 3)
    If TextBox1 = "" Then
        ara.[A2].Resize(UBound(Tbl)).NumberFormat = "@"
        ara.[C2].Resize(UBound(Tbl)).NumberFormat = "#,##0.00"
        ara.[A2].Resize(UBound(Tbl), 3).Value = Tbl
        ara.[A2].Resize(UBound(Tbl), 3).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 3
                    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:C" & ara_son + 1).ClearContents
        ara.Range("A2:C" & ara_son + 1).ClearFormats
        If say > 0 Then
            ara.[A2].Resize(say).NumberFormat = "@"
            ara.[C2].Resize(say).NumberFormat = "#,##0.00"
            ara.[A2].Resize(say, 3) = v
            ara.[A2].Resize(say, 3).Borders.Color = rgbSilver
        End If
    End If
End Sub

 

[mukoli]

Amacınız sayfaya listelemek ise kodu bu şekilde deneyiniz.

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("A1:C" & son).Value
ReDim v(1 To UBound(Tbl), 1 To 3)
    If TextBox1 = "" Then
        ara_son = ara.Range("B" & Rows.Count).End(xlUp).Row
        ara.Range("A2:C" & ara_son + 1).ClearContents
        ara.Range("A2:C" & ara_son + 1).ClearFormats
    Else
        xx = UCase(Replace(Replace(TextBox1, "i", "İ"), "ı", "I"))
        aranan = "*" & xx & "*"
        For x = 2 To UBound(Tbl)
            yy = UCase(Replace(Replace(Tbl(x, 2), "i", "İ"), "ı", "I"))
            If yy Like aranan Then
                say = say + 1
                For j = 1 To 3
                    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:C" & ara_son + 1).ClearContents
        ara.Range("A2:C" & ara_son + 1).ClearFormats
        If say > 0 Then
            ara.[A2].Resize(say).NumberFormat = "@"
            ara.[C2].Resize(say).NumberFormat = "#,##0.00"
            ara.[A2].Resize(say, 3) = v
            ara.[A2].Resize(say, 3).Borders.Color = rgbSilver
        End If
    End If
End Sub

Merhaba hocam çok teşekkür ederim aradığım kod ellerinize sağlık . Bir şey isteyebilirmiyim textbox boşken bütün bilgiyi çekse ana sayfadan olurmu

 

[Ziynettin]

Revize edildi. Kodu tekrar deneyin.

 

[mukoli]

Revize edildi. Kodu tekrar deneyin.

Teşekkrüler hocam ellerinize sağlık iyi akşamlar dilerim