• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

tüm sayfalardaki verileri bir listbox veya listwievde görme

Katılım
13 Kasım 2008
Mesajlar
81
Excel Vers. ve Dili
EXCEL2003
Tüm forum üyelerine hayırlı akşamlar.Benim acizane bir sorum olacak üstadlarıma. Bir çalışma kitabında beş tane sayfamız var ve bu sayfalarda aynı başlıklar altında verilerimiz mevcut.Bu beş sayfadaki verilerin tamamını bir userform üzerindeki listboxda görebilirmiyiz.Forumda buna benzer bir uygulama bulamadım.Yardımcı olursanız sevinirim.Teşekkürler Saygılar.
 
merhaba

userform üzerine listbox koyarak bu kodları dener misiniz
her sayfanın a sütunundaki değerleri listboxa ekleyecektir.

Kod:
Sub deneme()
UserForm1.Show
End Sub

Kod:
Private Sub UserForm_Activate()
Application.ScreenUpdating = False
For s = 1 To Sheets.Count
Sheets(s).Select
For i = 1 To Range("a65536").End(3).Row
Text = Cells(i, 1).Text
Me.ListBox1.AddItem Text
Next
Next
End Sub
 
...?

Sayın Uzmanamele ellerinize sağlık üstadım.Çok güzel olmuş allah başınızı ağrıtmasın.Siz birinci sütundan itibaren almışsınız.(Text = Cells(i, 2).Text) kodlarında 1 yerine 2 yazdığımızda b sütunundaki verileri alıyor.Ancak bir sütun değilde örneğin 5 sütundaki verilerin tamamını almak mümkünmü.Yani A1 den E1 e kadar olan verileri.Teşekkürler.
 
Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Kullanılan kod;
Kod:
Option Explicit
 
Private Sub CommandButton1_Click()
    Dim X As Byte, Sayfa As Worksheet, Satır As Long
 
    Application.ScreenUpdating = False
 
    On Error Resume Next
    For X = 1 To 5
    If Me.Controls("ComboBox" & X) = Empty Then Me.Controls("ComboBox" & X) = "*"
    Next
 
    ListBox1.Clear
 
    For Each Sayfa In Worksheets
 
    If Sayfa.AutoFilterMode Then Sayfa.Range("A1").AutoFilter
 
    If ComboBox1 <> "" And ComboBox1 <> "*" Then Sayfa.Range("A1").AutoFilter Field:=1, Criteria1:=ComboBox1
    If ComboBox2 <> "" And ComboBox2 <> "*" Then Sayfa.Range("A1").AutoFilter Field:=2, Criteria1:=ComboBox2
    If ComboBox3 <> "" And ComboBox3 <> "*" Then Sayfa.Range("A1").AutoFilter Field:=3, Criteria1:=ComboBox3
    If ComboBox4 <> "" And ComboBox4 <> "*" Then Sayfa.Range("A1").AutoFilter Field:=4, Criteria1:=ComboBox4
    If ComboBox5 <> "" And ComboBox5 <> "*" Then Sayfa.Range("A1").AutoFilter Field:=5, Criteria1:=ComboBox5
 
 
        For X = 2 To Sayfa.Cells(65536, 1).End(3).Row
            If Sayfa.Cells(X, 1).EntireRow.Hidden = False Then
            ListBox1.AddItem
            ListBox1.List(Satır, 0) = Sayfa.Cells(X, 1)
            ListBox1.List(Satır, 1) = Sayfa.Cells(X, 2)
            ListBox1.List(Satır, 2) = Sayfa.Cells(X, 3)
            ListBox1.List(Satır, 3) = Sayfa.Cells(X, 4)
            ListBox1.List(Satır, 4) = Sayfa.Cells(X, 5)
            Satır = Satır + 1
            End If
        Next
 
    If Sayfa.AutoFilterMode Then Sayfa.Range("A1").AutoFilter
 
    Next
 
    Application.ScreenUpdating = True
 
    If ListBox1.ListCount = 0 Then MsgBox "Kriterlerinize uygun kayıt bulunamamıştır !", vbCritical, "Dikkat !"
End Sub
 
Private Sub UserForm_Initialize()
    Dim Sayfa As Worksheet, X As Long, Y As Long, Satır As Long, Sütun As Byte
    Dim Liste As Variant, Hücre As Range, Veri As Variant
 
    ListBox1.ColumnCount = 5
    ListBox1.ColumnWidths = "70;70;70;70;70"
 
    For Each Sayfa In Worksheets
 
        If Sayfa.AutoFilterMode Then Sayfa.Range("A1").AutoFilter
 
        For X = 2 To Sayfa.Cells(65536, 1).End(3).Row
            ListBox1.AddItem
            ListBox1.List(Satır, 0) = Sayfa.Cells(X, 1)
            ListBox1.List(Satır, 1) = Sayfa.Cells(X, 2)
            ListBox1.List(Satır, 2) = Sayfa.Cells(X, 3)
            ListBox1.List(Satır, 3) = Sayfa.Cells(X, 4)
            ListBox1.List(Satır, 4) = Sayfa.Cells(X, 5)
            Satır = Satır + 1
        Next
 
    Next
 
    For Sütun = 1 To 5
    With CreateObject("Scripting.Dictionary")
        For Each Sayfa In Worksheets
 
            For Each Hücre In Sayfa.Range(Sayfa.Cells(2, Sütun), Sayfa.Cells(Sayfa.Cells(65536, Sütun).End(xlUp).Row, Sütun))
                If Not .exists(Hücre.Value) Then
                    .Add Hücre.Value, Nothing
                End If
            Next
 
        Next
 
        Liste = .keys
    End With
 
    For X = LBound(Liste) To UBound(Liste) - 1
        For Y = X + 1 To UBound(Liste)
            If StrComp(Liste(X), Liste(Y)) = 1 Then
                Veri = Liste(Y)
                Liste(Y) = Liste(X)
                Liste(X) = Veri
            End If
        Next
    Next
    On Error Resume Next
    Controls("ComboBox" & Sütun).List = Liste
    Next
End Sub
 

Ekli dosyalar

TŞK

Korhan hocam allah başınızı ağrıtmasın size ve diğer üstadlara sağlık sıhhat versin .Sizlerin sayesinde çok güzel uygulamaları görmek mümkün.Çok teşekkür ederim.Tam istediğim gibi olmuş.Bu uygulama zannedersem çok arkadaşın işine yarayacaktır.Çünkü istenilen veriler hiç sayfalara gitmeden göz önüne geliyor.Sizden bir ricam olacak size zahmet olmaz ise,ben bazı ara bul komutlarını form üzerinde denedim ancak hatalarla karşılaştım.Eklemiş olduğunuz forma her sütunda arama yapmak için arabul kodu ekleyerek istenilen veriyi listbox üzerinde süzme işlemi yapmak mümkünmü.Çok teşekkür ederim.Saygılar Hürmetler.
 
Selamlar,

Üstteki mesajımdaki kodu ve dosyayı güncelledim. İncelermisiniz.
 
Tşk

Korhan hocam çok teşekkür ederim.Ellerinize sağlık güzel bir çalışma örneği tabi bana göre.Diğer arkadaşlar nasıl düşünür bilemem.Çok güzel işler çıkarıyorsunuz allah başınızı ağrıtmasın.Korhan bey güzel bir söz vardır anlamlı ve insanın bu sözden çok şey çıkarabileceği benim çok hoşuma gider.Umarım tüm arkadaşlarında hoşuna gidecektir.GÜL VEREN ELDE, DAİMA GÜL KOKUSU KALIRMIŞ"Saygılar hürmetler.
 
Korhan hocam çok güzel bir çalışma fakat sizden bir ricada ben bulunmak istiyorum.comboboxtan arama yaparken tarih yada sayı formatında arama yaptıramıyorum kriterinize uygun kayıt bulunamadı hatası alıyorum.yardımınızı rica ederim.
 
sorun benim kendi datamdaymış teşekkürler.
 
Tam da "artık istediğim şey ile ilgili bir konu açılmamış, en iyisi ben sorayım bu soruyu " dediğim sırada rastgele bakınırken bunu buldum yaaa...valla ne diyeyim dünyalar benim oldu..allah sorandan da soruya cevap verenden de çook ama çook razı olsun..ellerinize..yüreğinize..aklınıza SAĞLIK...
 
Geri
Üst