• DİKKAT

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

Bir Listbox da Seçme yapınca Diğer Listbox da Detay

  • Konbuyu başlatan Konbuyu başlatan wolff
  • Başlangıç tarihi Başlangıç tarihi
W

wolff

Katılım
12 Aralık 2009
Mesajlar
35
Excel Vers. ve Dili
2007
Merhaba ekteki dosya ile ilgili bir sorum var istediğim şu burhanı tıkladığım zaman başta her müşterinin ID si var ID den bulacak ve o ID ye ait tüm kayıtları Listbox 2 ye yazacak
 

Ekli dosyalar

Bu şekilde deneyin.
Kod: 
Private Sub ListBox2_Click()
    x = ListBox2.ListIndex + 2
    ListBox1.RowSource = Range("c" & x & ":g" & x).Address
End Sub

Private Sub UserForm_Initialize()
'ListBox2.ColumnCount = 1
'ListBox2.ColumnWidths = "30;60;30;60,60"
 ListBox2.RowSource = "Sayfa1!b2:c" & Sheets("Sayfa1").Cells(Rows.Count, 1).End(3).Row
 ListBox2.ColumnHeads = True
End Sub
 
Kısmen oldu ama benim tam yapmak istediğim şu kısaca anlatıyım şimdi müşterileer ve siparişler diye bölüm olacak listbox1 müşterilerin adları olacak siparişler kısmındada müşteri ID ve Adı olacak ve sipariş detayları olacak ama ben müşteri adına 2 defa tıkladığımda ID den çekecek o müşteriye kaç tane sipariş gittiyse o yazacak kısmen bunu istiyorum yardımcı olursanız çok sevinirim şimdiden teşekkür ederim
 
hamitcan' Alıntı:
Bu şekilde deneyin.
Kod: 
Private Sub ListBox2_Click()
    x = ListBox2.ListIndex + 2
    ListBox1.RowSource = Range("c" & x & ":g" & x).Address
End Sub

Private Sub UserForm_Initialize()
'ListBox2.ColumnCount = 1
'ListBox2.ColumnWidths = "30;60;30;60,60"
 ListBox2.RowSource = "Sayfa1!b2:c" & Sheets("Sayfa1").Cells(Rows.Count, 1).End(3).Row
 ListBox2.ColumnHeads = True
End Sub
Genişletmek için tıkla ...

Çok teşekkür ederim aşağıda yapmak istediğimi anlattım buda son hali ekteki dosya
 

Ekli dosyalar

Merhaba.

Listelerinizdeki satır sayısı çoğaldığında yavaşlama olmaması bakımından;
For...Next döngüsüyle verileri alttaki Listbox'a aktarmak yerine,
Sayfa3'ü alttaki Listbox için veri kaynağı olarak kullanmak uygun sanırım.
Üstteki Listboxta çift tıklanan isime ait Sayfa1'deki veriler Sayfa3'e aktarılır, oradan da alttaki Listbox'ta görüntülenir.

Userform'a ait kodlara aşağıdakini de ekleyin.
.
Kod: 
[B][COLOR="red"]Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)[/COLOR][/B]
Application.ScreenUpdating = False
Sheets("[B][COLOR="Blue"]Sayfa3[/COLOR][/B]").Range("A1:G" & Sheets("[B][COLOR="Blue"]Sayfa3[/COLOR][/B]").Cells(Rows.Count, 1).End(3).Row).ClearContents
Sheets("Sayfa1").Range("A1:G1").AutoFilter Field:=2, Criteria1:=ListBox2.ListIndex + 1
Sheets("Sayfa1").Range("A1:G" & Sheets("Sayfa1").Cells(Rows.Count, 1).End(3).Row).Copy _
    Sheets("[B][COLOR="Blue"]Sayfa3[/COLOR][/B]").[A1]
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "50;100;60;60"
Sheets("Sayfa1").Range("A1:G1").AutoFilter Field:=2
ListBox1.RowSource = "[B][COLOR="Blue"]Sayfa3[/COLOR][/B]!D2:G" & Sheets("[B][COLOR="Blue"]Sayfa3[/COLOR][/B]").Cells(Rows.Count, 1).End(3).Row
ListBox1.ColumnHeads = True
Application.ScreenUpdating = False
[B][COLOR="Red"]End Sub[/COLOR][/B]
 
Ömer BARAN' Alıntı:
Merhaba.

Listelerinizdeki satır sayısı çoğaldığında yavaşlama olmaması bakımından;
For...Next döngüsüyle verileri alttaki Listbox'a aktarmak yerine,
Sayfa3'ü alttaki Listbox için veri kaynağı olarak kullanmak uygun sanırım.
Üstteki Listboxta çift tıklanan isime ait Sayfa1'deki veriler Sayfa3'e aktarılır, oradan da alttaki Listbox'ta görüntülenir.

Userform'a ait kodlara aşağıdakini de ekleyin.
.
Kod: 
[B][COLOR="red"]Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)[/COLOR][/B]
Application.ScreenUpdating = False
Sheets("[B][COLOR="Blue"]Sayfa3[/COLOR][/B]").Range("A1:G" & Sheets("[B][COLOR="Blue"]Sayfa3[/COLOR][/B]").Cells(Rows.Count, 1).End(3).Row).ClearContents
Sheets("Sayfa1").Range("A1:G1").AutoFilter Field:=2, Criteria1:=ListBox2.ListIndex + 1
Sheets("Sayfa1").Range("A1:G" & Sheets("Sayfa1").Cells(Rows.Count, 1).End(3).Row).Copy _
    Sheets("[B][COLOR="Blue"]Sayfa3[/COLOR][/B]").[A1]
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "50;100;60;60"
Sheets("Sayfa1").Range("A1:G1").AutoFilter Field:=2
ListBox1.RowSource = "[B][COLOR="Blue"]Sayfa3[/COLOR][/B]!D2:G" & Sheets("[B][COLOR="Blue"]Sayfa3[/COLOR][/B]").Cells(Rows.Count, 1).End(3).Row
ListBox1.ColumnHeads = True
Application.ScreenUpdating = False
[B][COLOR="Red"]End Sub[/COLOR][/B]
Genişletmek için tıkla ...



Teşekkür ederim ama hata veriyor hiç açılmıyor örnek dosya ekte var acaba yapabilirmisiniz
 
Merhaba,

Uğraşmıştım boşa gitmesin.
Alternatif:

Eski kodları silerek yeni kodları ekleyin.

Kod: 
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    Dim Ss As Worksheet, S1 As Worksheet, c As Range, Adr As String, deg, a, dizi()

    Set Ss = Sheets("FİRMA")
    Set S1 = Sheets("Sayfa1")
    deg = Ss.Cells(ListBox2.ListIndex + 2, "A")
    
    ReDim dizi(1 To 4, 1 To 1)
    ListBox1.ColumnCount = 4
    ListBox1.ColumnWidths = "60;90;70,60"
    
    Set c = S1.[B:B].Find(deg, , xlValues, xlWhole)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            a = a + 1
            ReDim Preserve dizi(1 To 4, 1 To a)
            For j = 1 To 4
                dizi(j, a) = S1.Cells(c.Row, j + 3).Value
            Next j
            Set c = S1.[B:B].FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    End If
    
    ListBox1.Column = dizi
    
End Sub

Private Sub UserForm_Initialize()
    
    With ListBox2
        .ColumnCount = 2
        .ColumnWidths = "30;60"
        .RowSource = "FİRMA!A2:B" & Sheets("FİRMA"). _
            Cells(Rows.Count, "A").End(xlUp).Row
        .ColumnHeads = True
    End With
    
End Sub

.
 
Ömer' Alıntı:
Merhaba,

Uğraşmıştım boşa gitmesin.
Alternatif:

Eski kodları silerek yeni kodları ekleyin.

Kod: 
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    Dim Ss As Worksheet, S1 As Worksheet, c As Range, Adr As String, deg, a, dizi()

    Set Ss = Sheets("FİRMA")
    Set S1 = Sheets("Sayfa1")
    deg = Ss.Cells(ListBox2.ListIndex + 2, "A")
    
    ReDim dizi(1 To 4, 1 To 1)
    ListBox1.ColumnCount = 4
    ListBox1.ColumnWidths = "60;90;70,60"
    
    Set c = S1.[B:B].Find(deg, , xlValues, xlWhole)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            a = a + 1
            ReDim Preserve dizi(1 To 4, 1 To a)
            For j = 1 To 4
                dizi(j, a) = S1.Cells(c.Row, j + 3).Value
            Next j
            Set c = S1.[B:B].FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    End If
    
    ListBox1.Column = dizi
    
End Sub

Private Sub UserForm_Initialize()
    
    With ListBox2
        .ColumnCount = 2
        .ColumnWidths = "30;60"
        .RowSource = "FİRMA!A2:B" & Sheets("FİRMA"). _
            Cells(Rows.Count, "A").End(xlUp).Row
        .ColumnHeads = True
    End With
    
End Sub

.
Genişletmek için tıkla ...

hocam süpersiniz çok teşekkür ederim Allah razı olsun
 
wolff' Alıntı:
hocam süpersiniz çok teşekkür ederim Allah razı olsun
Genişletmek için tıkla ...

merhaba hocam verdiğiniz proje çalıştı ancak detayın üzerine tıklanınca textboxlara tam doğru bilgi atamıyor mesela bir alttakini atıyor bir hata var dosya ek te bakabilirmisiniz ,
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst