Ürün Ağacını Otomatik Getirme

[zehirlee]

Merhaba Arkadaşlar, Değerli Hocalarım,
Üstesinden gelemediğim bir konuyu aktarmak istiyorum. Yardım ederseniz mutlu olurum.

Bir ürün ağacı var ve bu ürün ağacında bulunan kodlar var kod üzerine tıkladığım zaman ürün ağacında kullanılan tüm malzemeleri önüme dökmesini istiyorum. 1 kod için en az 15-20 kalem malzeme var. Örnek excel dosyası ektedir.
Sorularınızı yanıtlamaya hazırım. Olmaz ise de belirtmenizi rica ederim.

Teşekkürler

 

[YUSUF44]

Ekli dosyayı inceleyiniz:

 

[turist]

Merhaba Arkadaşlar, Değerli Hocalarım,
Üstesinden gelemediğim bir konuyu aktarmak istiyorum. Yardım ederseniz mutlu olurum.

Bir ürün ağacı var ve bu ürün ağacında bulunan kodlar var kod üzerine tıkladığım zaman ürün ağacında kullanılan tüm malzemeleri önüme dökmesini istiyorum. 1 kod için en az 15-20 kalem malzeme var. Örnek excel dosyası ektedir.
Sorularınızı yanıtlamaya hazırım. Olmaz ise de belirtmenizi rica ederim.

Teşekkürler

Dosyanız eklidir.

 

[zehirlee]

Her iki üstada ayrı ayrı teşekkür ederim. İki çözümde çok profesyonelce. Esas dosya paylaşımı yapıp o dosya üzerinde yardım istesem daha doğru olacak. Bu şekilde uyarlamayı beceremedim.

 

[tugkan]

@turist ve @YUSUF44 hocam,
Liste göstermeyi listbox olarak değilde normal hücrelerde nasıl gösterebiliriz?

 

[YUSUF44]

Aşağıdaki kodda hem listboxa hem de hücreye alma yöntemi var:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
son = WorksheetFunction.Max(3, Cells(Rows.Count, "B").End(3).Row)
    Dim xSheet As Worksheet
    On Error Resume Next
If Intersect(Target, Range("B3:B" & Rows.Count)) Is Nothing Then Exit Sub
    ListBox1.Clear
'Bu kısım listboxa listelemek için
If Target = "" Then
    ListBox1.Clear
    Exit Sub
End If
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    liste = WorksheetFunction.Max(2, Sheets("ÜRÜN AĞAÇLARI").Cells(Rows.Count, "A").End(3).Row)
    If ListBox1.ListCount <> liste Then
        ListBox1.Clear
        For i = 2 To liste
            If Sheets("ÜRÜN AĞAÇLARI").Cells(i, "A") = Target Then
                ListBox1.AddItem Sheets("ÜRÜN AĞAÇLARI").Cells(i, "B")
            End If
        Next
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True

'Bu kısım hücreye (E3'ten itibaren) listelemek için
eski = WorksheetFunction.Max(3, Cells(Rows.Count, "E").End(3).Row)
If Target = "" Then
    Range("E3:E" & eski).ClearContents
    Exit Sub
End If
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    liste1 = WorksheetFunction.Max(2, Sheets("ÜRÜN AĞAÇLARI").Cells(Rows.Count, "A").End(3).Row)
    If WorksheetFunction.CountIf(Sheets("ÜRÜN AĞAÇLARI").Range("A1:A" & liste1), Target) > 0 Then
        Range("E3:E" & eski).ClearContents
        For j = 2 To liste1
            If Sheets("ÜRÜN AĞAÇLARI").Cells(j, "A") = Target Then
                yeni = WorksheetFunction.Max(3, Cells(Rows.Count, "E").End(3).Row + 1)
                Cells(yeni, "E") = Sheets("ÜRÜN AĞAÇLARI").Cells(j, "B")
            End If
        Next
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

 

[tugkan]

Teşekkür ederim Sayın @YUSUF44

 

[zehirlee]

@YUSUF44 Üstad bu kutu içerisinde (listbox) 3 farklı yeri gösterebilirmiyiz. Mesela
1.A (suanki hali)
2. detay parçasının adı
3. adeti gibi?

 

[YUSUF44]

Muhtemelen yapılır ama ben bilmiyorum maalesef. Yapacak arkadaşlar için bu bahsettiğiniz duruma uygun örnek dosya paylaşırsanız iyi olur.

 

[zehirlee]

Çok teşekkür ederim üstad