excel ile ağaç göstermek

Katılım
18 Ağustos 2009
Mesajlar
3
Excel Vers. ve Dili
2007 tr
ben bir tür veri ağacı göstermek istiyorum. başka biyerdeki tablıomu tarayım ürün ağacı gibi bişey yapabilirmiyim. Ekte bir dosya attım.. düşeyrara işini her seferinde bir sonraki değeri bulması için çalıştırsam belki yapabilirim. yardımcı olabilecek kimse var mı?
 

ŞAHİNce

Altın Üye
Katılım
14 Nisan 2006
Mesajlar
183
Excel Vers. ve Dili
TR 2010
Altın Üyelik Bitiş Tarihi
11.02.2028
Güzel Türkçemize özen gösterseniz, mesajlarınız daha çok okunur.
 
Katılım
18 Ağustos 2009
Mesajlar
3
Excel Vers. ve Dili
2007 tr
hallettim formulle çözemedim ama makro ile çözdüm. sonra da tutup formulle görselleştirdim. Kod şöyle.

Kod:
Public defsatir As Integer
Sub Click()
   Dim aranan As String
    aranan = sonuc.Cells(2, 8)
    defsatir = 5
    Dim seviye As Integer
        seviye = 0
    For x = defsatir To 1000
    For y = 1 To 6
        sonuc.Cells(x, y) = Null
    Next y
    Next x
    
    
    
    sonuc.Cells(defsatir, 1) = seviye
    sonuc.Cells(defsatir, 2) = "M"
    sonuc.Cells(defsatir, 3) = aranan
    sonuc.Cells(defsatir, 4) = Null
    sonuc.Cells(defsatir, 5) = Null
    sonuc.Cells(defsatir, 6) = Null
    
    
    seviye = yazbul(aranan, "0", seviye + 1, False) - 1
    
    
End Sub

Function yazbul(aranan As String, operisim As String, seviye As Integer, malzeme As Boolean) As Integer

If malzeme Then
'bu bir malzeme
    For x = 1 To 35000
        If sboperma.Cells(x, 3) = aranan And sboperma.Cells(x, 2) = operisim Then
            defsatir = defsatir + 1
            sonuc.Cells(defsatir, 1) = seviye
            sonuc.Cells(defsatir, 2) = "M"
            sonuc.Cells(defsatir, 3) = sboperma.Cells(x, 4)
            sonuc.Cells(defsatir, 4) = operisim
            sonuc.Cells(defsatir, 5) = sboperma.Cells(x, 6)
            sonuc.Cells(defsatir, 6) = sboperma.Cells(x, 7)
            'seviye = yazbul(sboperma.Cells(x, 4), sevite + 1) - 1
            seviye = yazbul(sboperma.Cells(x, 4), operisim, seviye + 1, False) - 1
            
        End If
    Next x
Else
'bu bir operasyon

    For x = 1 To 35000
        If sboper.Cells(x, 4) = aranan Then
            defsatir = defsatir + 1
            sonuc.Cells(defsatir, 1) = seviye
            sonuc.Cells(defsatir, 2) = "O"
            sonuc.Cells(defsatir, 3) = aranan
            sonuc.Cells(defsatir, 4) = sboper.Cells(x, 2)
            sonuc.Cells(defsatir, 5) = Null
            sonuc.Cells(defsatir, 6) = Null
            'seviye = yazmalbul(aranan, sboper.Cells(x, 2), seviye + 1) - 1
            seviye = yazbul(aranan, sboper.Cells(x, 2), seviye + 1, True) - 1
            
            
        End If
    Next x
End If
yazbul = seviye

End Function
 
Üst