Liste aller Lieferketten

Hi,
ich hoffe ihr koennt mir weiterhelfen.
Fuer meine Forschungsarbeit, suche ich nach einer Moeglichkeit alle Varianten von Lieferketten auszugeben mit jeweils einer pro Zeile und jeweils ueber Spalte A bis ... verteilt.
Ausgangsmaterial sind zwei Spalten mit 1. Spalte Kunden und 2. Spalte Lieferanten, also many to many Beziehungen.
Ich suche nun nach tiefen Lieferketten, d.h es waere gut, wenn man nur die Lieferketten angeben kann, die hinter dem direkten Zulieferer nochmals Zulieferer haben (kann man auch selbst sein (Loop), was zu einem Stop und Zeileneintrag fuehrt). Soll dann so aehnlich aussehen wie bei StudiVZ mit den Leuten die zwischen einem selbst und der anderen Person stehen.
Ich habe ein grobe Ahnung wie ich es mit VBA loesen koennte, aber meine Ahnung sagt mir auch, dass Excel bei meinen Anfaenger-VBA sehr lange rechnen wird :-)
Ich hoffe, jemand hat eine elegantere Loesung fuer dieses Problem parat.
Besten Dank im Voraus!
G

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Glenn,
Ich hoffe, jemand hat eine elegantere Loesung fuer dieses Problem parat.
Da wir deine Lösung nicht kennen, wissen wir natürlich nicht, ob es eine elegantere Lösung gibt.
Außerdem wäre eine kleine Beispieltabelle mit ein paar Daten und der gewünschten Ergebnisdarstellung hilfreich.
Gruß
Franz
Nach meinem Verständnis müsste es wie folgt funktionieren:

Sub Lieferkette()
Dim wks As Worksheet, wksZiel As Worksheet
Dim Zeile As Long, Spalte As Long, ZeileZ As Long, ZeileL As Long
Dim Zelle As Range, Anzahl As Long
Dim Kunde, Lieferant
Const Zeile_1 As Long = 2   '1. Zeile mit Kunde|Lieferant daten
Set wks = Worksheets(1)     'Tabellenblatt mit den Kunde|Lieferant Daten
Set wksZiel = Worksheets(2) 'Blatt für die Lieferantenbeziehungen
'Alle Daten im Zielblatt löschen
wksZiel.UsedRange.Clear
With wks
ZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row
For Zeile = Zeile_1 To ZeileL
Kunde = .Cells(Zeile, 1)
Lieferant = .Cells(Zeile, 2)
Spalte = 1 'Einfügespalte für Kunden-Name in Zieltabelle
ZeileZ = ZeileZ + 1
wksZiel.Cells(ZeileZ, Spalte) = Kunde
Do
Spalte = Spalte + 1
wksZiel.Cells(ZeileZ, Spalte) = Lieferant
'Liefranten in Spalte A der Daten suchen
Set Zelle = .Range(.Cells(Zeile_1, 1), .Cells(ZeileL, 1)).Find(what:=Lieferant, _
LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then 'Lieferant nicht unter Kunden
Exit Do
ElseIf Zelle.Value = Kunde Then 'Lieferant=Kunde
Exit Do
Else
Lieferant = .Cells(Zelle.Row, 2)
With wksZiel
'Prüfen, ob Lieferant schon in Kette eingetragen
If Application.WorksheetFunction.CountIf(.Range(.Cells(ZeileZ, 1), _
.Cells(ZeileZ, Spalte)), Lieferant) > 0 Then Exit Do
End With
End If
Loop
Next
End With
End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread