Çözüldü Textbox ile başka sayfadan veri getirme

[hamza2011]

Merhaba,
Ek'li dosyada açıklamalı olarak da belirttiğim gibi textbox kutusuna girdiğim değeri/değerleri başka sayfadan alarak süzmek istiyorum.

Lütfen konu hakkında yardımlarınıza ihtiyacım var. Kolay gelsin.

 

[ÖmerBey]

Merhaba,
İlk olarak başlıkta yer alan (ACİL YARDIM) metninin site kurallarına aykırı olduğunu belirteyim.
İkinci olarak hangi sütunda arama yapacaksınız? Yani textboxa yazdığınız verinin karşığı veri sayfasındaki hangi sütunda yer alıyor.
Üçüncü olarak da filtreleme metodu ne olacak (başlayan, içeren, tam eşleşme)

 

[hamza2011]

Ömer Bey Merhaba,
Haklısınız, başlığı değiştirdim.
A sütununda ve tam eşleşme olarak filtrelemek istiyorum.

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodları gör sayfasının kod bölümüne kopyalayıp deneyiniz.

Private Sub TextBox1_Change()
Range("A5:H100").ClearContents
If TextBox1 = "" Then Exit Sub
Dim v As Worksheet
Dim a As Integer, b As Integer, s As Integer, x As Integer
Set v = Sheets("VERİ")
s = WorksheetFunction.CountIf(v.Range("A:A"), TextBox1.Value)
If s > 0 Then
    ReDim dz(1 To s, 1 To 8)
    For a = 3 To v.Cells(Rows.Count, 1).End(3).Row
        If v.Cells(a, "A") Like TextBox1.Value Then
            x = x + 1
            For b = 1 To 8
                dz(x, b) = v.Cells(a, b)
            Next
        End If
    Next
    Range("A5").Resize(UBound(dz), UBound(dz, 2)).Value = dz
End If
End Sub

 

[hamza2011]

Ömer Bey, çok teşekkür ederim. Emeğinize sağlık. Minnettarım.

Ben Ek' li dosyaya bir ilave daha yaptım. Sizden ricam tekrar bakabilir misiniz.

 

[ÖmerBey]

Örnek dosyanızdaki gör sayfasındaki kodu tamamen silip aşağıdaki kodu kopyalayınız.

Private Sub TextBox1_Change()
Veri_Al
End Sub
Private Sub TextBox2_Change()
Veri_Al
End Sub
Private Sub TextBox3_Change()
Veri_Al
End Sub
Private Sub TextBox4_Change()
Veri_Al
End Sub

Private Sub Veri_Al()
Dim v As Worksheet
Dim a As Integer, b As Integer, x As Integer
Dim t1 As Date, t2 As Date
Dim d1 As String, d2 As String

Range("A5:H100000").ClearContents
If TextBox1 & TextBox2 & TextBox3 & TextBox4 = "" Then Exit Sub
If TextBox1 = "" Then d1 = "*" Else d1 = TextBox1 '1
If IsDate(TextBox2) Then t1 = TextBox2 Else t1 = DateValue("01.01.1900") 'büyüktür
If TextBox3 = "" Then d2 = "*" Else d2 = TextBox3 '2
If IsDate(TextBox4) Then t2 = TextBox4 Else t2 = DateValue("31.12.2050")  'Küçüktür


Set v = Sheets("VERİ")
ReDim dz(1 To 8, 1 To 1)
For a = 3 To v.Cells(Rows.Count, 1).End(3).Row
    If v.Cells(a, "A") Like d1 And v.Cells(a, "B") Like d2 And DateValue(v.Cells(a, "E")) > t1 And DateValue(v.Cells(a, "E")) < t2 Then
        x = x + 1
        ReDim Preserve dz(1 To 8, 1 To x)
        For b = 1 To 8
            dz(b, x) = v.Cells(a, b)
        Next
    End If
Next
    Range("A5").Resize(UBound(dz, 2), UBound(dz)).Value = Application.Transpose(dz)
End Sub

 

[hamza2011]

Ömer Bey, tekrar emeğinize sağlık.
Yanlız ben sanırım size anlatımda hata yaptım. Daha doğrusu eksik bilgi verdim. Şöyle ki; asıl dosyamda ben 15 ya da 20' ye yakın textbox kutusu kullanacağım ve 15 - 20 adet sütun olacak. Dolayısıyla yeni ekleyeceğim kodları nereye ekleyeceğimi tam çözemedim (haliyle de sürekli size geri dönemem/rahatsız edemem). Kodları artık başka bir tasarımda kullanırım. Buna başka bir çözüm aramak durumundayım.
Bana cevaben yapmış olduğunuz ilgi alakanızdan dolayı sonsuz teşekkürlerimi sunarım. Hoşçakalın.

 

[ÖmerBey]

Rica ederim,
İyi çalışmalar diliyorum...