|
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:
Option Explicit 'non global or non modular variables used in Subs or funciton have to be declared by dim
Option Base 1 ' all arrays start with index 1
Public Value As Variant 'the value to be stored at the current node
Public LeftChild As TreeItem 'pointer to the left child node
Public RightChild As TreeItem 'pointer to the right child node
Klasse Tree:
Option Explicit 'non global or non modular variables used in Subs or funciton have to be declared by dim
Option Base 1 ' all arrays start with index 1
'the class only contains one data item, the head of the tree or the root!
Private tiHead As TreeItem
'these module variables are used when adding new nodes
Private mblnAddDupes As Boolean '(mbln...moduleboolean)to allow duplicates or not
Private mvarItemToAdd As Variant '(mvar...modulvariable)for the value to be added to the tree
'The method that adds items to the binary tree uses these modul-level variables.
Private Sub Class_Initialize() ' This event is fired when an instance of the class is created Set objClass = New MyClass
'statements
End Sub
'*********************************************************
'TWO WAYS TO ADD NEW ITEMS
'*********************************************************
Public Sub Add(varNewItem As Variant)
'Add a new node, allowing duplicates.
'Use module variables to place as little as
'possible of the memory in recursive procedure calls
mblnAddDupes = True
mvarItemToAdd = varNewItem
Call AddNode(tiHead)
End Sub
Public Sub AddUnique(varNewItem As Variant)
'Add a new node, skipping duplicate values
'Use module variables to place as little as
'possible of the memory in recursive procedure calls
mblnAddDupes = False
mvarItemToAdd = varNewItem
Call AddNode(tiHead)
End Sub
'*********************************************************
'RECURSIVE AddNode PROCEDURE (adds a new node to the tree)
'*********************************************************
Private Function AddNode(ti As TreeItem) As TreeItem
'Add a node to the tree pointed by ti (tree indicator)
'Following module variables used:
'- mvarItemtoAdd: the value to add to the tree
'- mblnAddDupes: Boolean indicating wheter to add items
'that already exist or to skip them.
If ti Is Nothing Then
'tree item is not yet existing
'create new one and save value
Set ti = New TreeItem
Else
'left or right child
If mvarItemToAdd < ti.Value Then
Set ti.LeftChild = AddNode(ti.LeftChild)
ElseIf mvarItemToAdd > ti.Value Then
Set ti.RightChild = AddNode(ti.RightChild)
Else
'you are adding a node that already exists.
'You could add it to the left or to the right
'but this code arbitrarily adds it to the right
'if duplicates are allowed
If mblnAddDupes = True Then
Set ti.RightChild = AddNode(ti.RightChild)
End If
End If
End If
Set AddNode = ti 'return value
End Function
Falls es jemanden interessiert, hier mein Code, der die Beziehung analysiert und die Liste erstellt:
Public Sub ScanSchema()
'scans all shapes on specific worksheet and checks if they are connectors
'if they are, create a mother-child relation and safe it to the first columns of the worksheet
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
'rename connector ("name of beginning shape -> name of ending shape")
With shp.ConnectorFormat
shp.Name = .BeginConnectedShape.Name & "->" & .EndConnectedShape.Name
End With
'Connector is mother from the shape where the beginning of the connector is attached to
Worksheets(SCHEMA).Cells(rowCounter, 1).Value _
= shp.Name
Worksheets(SCHEMA).Cells(rowCounter, 2).Value _
= shp.ConnectorFormat.BeginConnectedShape.Name
rowCounter = rowCounter + 1
'Connector is child of the shape where the end of the connector is attached to
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!
|