|
Hallo liebe Gemeinde,
Ich bin mit meiner Aufgabenstellung am verzweifeln - ich hoffe ihr könnt mir weiterhelfen.
Ziel meiner Excel-VBA-Anwendung ist:
Der Benutzer kann auf einem Excel sheet beliebig viele von ihm benannte (shapename) Formelemente wie Kreise, Dreiecke etc. mit Konnektoren also Pfeilen verbinden.
Jeder Knoten kann maximal zwei Kinder haben. Auch die Konnektoren welche automatisch benannt werden, werden als Element gesehen und haben Mutter und Kind-Knoten. Alle Formen sind durch einen eindeutigen Namen charakterisiert (shape.name).
Ich hab das Programm jetzt so weit, dass er die Zusammenhänge ausließt und in eine Liste schreibt, siehe Screenshot:
So weit so gut.
Ich muss mit dieser Struktur der Verschaltung iterative Berechnungen von den Blättern in Richtung Wurzel durchführen. Es reicht mir dazu, wenn nur der Name der Form als String für jeden Knotenpunkt abgespeichert ist.
Leider schaffe ich es nicht aus diesen Informationen einen "Baum" aufzubauen.
Ich weiß, dass ich dafür eine rekursive Funktion benötige... aber beim Nachdenken darüber wie ich das realisieren könnte bekomme ich immer wieder einen Knoten im Hirn^^
Den Wurzelknoten der Baumstruktur kann ich bereits identifizieren (ist eine Mutter welche nicht in der Kindliste auftaucht) aber dann weiß ich nicht mehr weiter.
Ich glaube um später den Baum von hinten durchrechnen zu können wäre es sinnvoll, wenn ich die Baumstruktur dann als 2D-Array abspeichere. Bin da aber für bessere Vorschläge offen.
Im Internet habe ich einen halbwegs guten Ansatz gefunen, eine Anleitung für einen Binärbaum gefunden (2 Klassen)
Mit dieser Add Node Funktion lassen sich leider nur neue Knoten einfügen, welche nach ihrer Größe nach einsortiert werden (also rechts oder links). Ich benötige aber die Verschaltung wie in der Skizze.
Hier die zwei Klassen, welche ich gefunden habe:
Klasse TreeItem:
1 2 3 4 5 6 | Option Explicit
Option Base 1
Public Value As Variant
Public LeftChild As TreeItem
Public RightChild As TreeItem
|
Klasse Tree:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | Option Explicit
Option Base 1
Private tiHead As TreeItem
Private mblnAddDupes As Boolean
Private mvarItemToAdd As Variant
Private Sub Class_Initialize()
End Sub
Public Sub Add(varNewItem As Variant)
mblnAddDupes = True
mvarItemToAdd = varNewItem
Call AddNode(tiHead)
End Sub
Public Sub AddUnique(varNewItem As Variant)
mblnAddDupes = False
mvarItemToAdd = varNewItem
Call AddNode(tiHead)
End Sub
Private Function AddNode(ti As TreeItem) As TreeItem
If ti Is Nothing Then
Set ti = New TreeItem
Else
If mvarItemToAdd < ti.Value Then
Set ti.LeftChild = AddNode(ti.LeftChild)
ElseIf mvarItemToAdd > ti.Value Then
Set ti.RightChild = AddNode(ti.RightChild)
Else
If mblnAddDupes = True Then
Set ti.RightChild = AddNode(ti.RightChild)
End If
End If
End If
Set AddNode = ti
End Function
|
Falls es jemanden interessiert, hier mein Code, der die Beziehung analysiert und die Liste erstellt:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | Public Sub ScanSchema()
Dim shp As shape
Dim shapeCounter As Integer
Dim rowCounter As Integer: rowCounter = 2
Dim shapeIdentifierShadowSize As Integer
For Each shp In Worksheets(SCHEMA).SHAPES
shapeCounter = shapeCounter + 1
If shp.Connector = True Then
With shp.ConnectorFormat
shp.Name = .BeginConnectedShape.Name & "->" & .EndConnectedShape.Name
End With
Worksheets(SCHEMA).Cells(rowCounter, 1).Value _
= shp.Name
Worksheets(SCHEMA).Cells(rowCounter, 2).Value _
= shp.ConnectorFormat.BeginConnectedShape.Name
rowCounter = rowCounter + 1
Worksheets(SCHEMA).Cells(rowCounter, 2).Value _
= shp.Name
Worksheets(SCHEMA).Cells(rowCounter, 1).Value _
= shp.ConnectorFormat.EndConnectedShape.Name
rowCounter = rowCounter + 1
End If
Next shp
End Sub
|
Bin euch für eure Inputs sehr dankbar!
|