Excel Kitabındaki Tüm aynı başlıkları, bir sayfaya toplama.

[akineton_1]

Merhabalar,

Excel de, yapmak isteğim sayfam için yardıma ihtiyacım var. forumda da aradım ama bulamadım.

Ekteki dosyamda da göreceğiniz gibi,
datalarımın hepsi bir sayfada alt alta olduğu zaman, verileri tekxbox ile süzebiliyorum. başka sayfada da olsa getirebiliyorum.

Fakat aynı sutun başlıklarının bir kaç sayfadan aynı anda ekranıma getiremiyorum.
konu hakkında yardımlarınız. şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Ekteki örnek dosyayı incelermisiniz.

 

[akineton_1]

Üstadım, Tek kelime ile mükemmel.
ellerin dert görmesin. nasıl bir derrten kurtartığını bilsen.

 

[akineton_1]

Peki üstadım daha başka çalışma sayfası eklersem. aynı formatta koda yazmama gerek varmıdır.
yoksa otomatik alacak mı ?

 

[akineton_1]

Bütün sheetlere bakıyor üstadıum teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Alternatif olarak aşağıdaki kodları da kullanabilirsiniz. Çok veriniz varsa daha hızlı sonuç verecektir.

Private Sub TextBox1_Change()
    Dim Dizi, X, Adres, Bul, Say
    
    Application.ScreenUpdating = False
    
    Range("A3:E" & Rows.Count).ClearContents
    
    If TextBox1 <> "" Then
        ReDim Dizi(1 To 5, 1 To 1)
        
        For X = 2 To Sheets.Count
            Set Bul = Sheets(X).Range("B:B").Find(TextBox1, , , xlPart)
            If Not Bul Is Nothing Then
                Adres = Bul.Address
                Do
                    If Bul.Row > 1 Then
                        Say = Say + 1
                        ReDim Preserve Dizi(1 To 5, 1 To Say)
                        Dizi(1, Say) = Bul.Offset(0, -1).Value
                        Dizi(2, Say) = Bul.Value
                        Dizi(3, Say) = Bul.Offset(0, 1).Value
                        Dizi(4, Say) = Bul.Offset(0, 2).Value
                        Dizi(5, Say) = Sheets(X).Name
                    End If
                    Set Bul = Sheets(X).Range("B:B").FindNext(Bul)
                Loop While Not Bul Is Nothing And Bul.Address <> Adres
            End If
        Next
    
        Application.ScreenUpdating = True
        
        If Say > 0 Then
            Range("A3").Resize(Say, 5) = Application.Transpose(Dizi)
        Else
            MsgBox "Uygun kayıt bulunamadı !", vbCritical
        End If
        
        Range("A:E").EntireColumn.AutoFit
    End If
End Sub

 

[Necdet]

Merhaba,

Alternatif olsun.

Marka, model ve Özellik seçimine göre arama yaptırabilirsiniz.

Textbox taki değişime göre arama yaptırmadım bunun nedeni her harf girişinde arama yapmak işi uzatır diye düşündüm dolayısıyla kodları bir butona bağladım.

Aşağıdaki kodlar modülde olmalıdır.

Sub AraBulGetir()
 
    Dim Kol As Integer
    Dim c   As Range
    Dim i   As Long
    Dim j   As Long
    Dim Syf As Worksheet
    Dim Ara As String
    
    Application.ScreenUpdating = False
    
    Ara = Range("F1")
    i = Cells(Rows.Count, "A").End(3).Row
    If i < 3 Then i = 2
    Range("A3:F" & i).ClearContents
    
    
    On Error Resume Next
    For Each Syf In Worksheets
        If Syf.Name <> "ANA" Then
            Set c = Syf.Range("1:1").Find(Ara, LookIn:=xlValues)
            If Not c Is Nothing Then
                Kol = c.Column
                j = Syf.Cells(Rows.Count, "A").End(3).Row
                Syf.Range("A1:D" & j).AutoFilter Field:=Kol, Criteria1:="*" & Sheets("ANA").TextBox1.Text & "*"
                i = Cells(Rows.Count, "A").End(3).Row + 1
                Syf.Range("A1").CurrentRegion.Copy Range("A" & i)
                Rows(i).Delete
                Syf.Cells.AutoFilter
            End If
        End If
    Next Syf
    
    Application.ScreenUpdating = True
    
End Sub

 

[akineton_1]

Teşekkürler üstatlar,
Korhan beyin 2 nci verdiği kodlar gerçekten uçurdu searchı, 1000000 yakın veri ile çalışıyodum.
Necdet beyin son makro kodunuda başka bir sistemde kullandım çok işime yaradı.

 

[akineton_1]

Üstadım,
bu hizlı kodların içine Texbox'a veri klavyeden girilemesin, yanlızca Copy/Paste yapılmasını sağlayabilirmiyim.
arakdaşın bilgisayarınada koydum. yanlışlıkla 1 harfe bastı, allah allah 10 dk.

kodun içine yazılabilenyanlızca, paste yapmaya izin veren bir kod mevcutmudur.