Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
19.08.2020 13:28:59 |
Julian |
|
|
|
19.08.2020 13:47:37 |
Gast30922 |
|
|
|
19.08.2020 14:09:52 |
Julian |
|
|
|
19.08.2020 14:49:37 |
Ralf |
|
|
|
19.08.2020 15:23:14 |
Gast48020 |
|
|
|
19.08.2020 18:50:15 |
Gast96999 |
|
|
|
19.08.2020 19:26:09 |
Julian |
|
|
|
20.08.2020 10:39:56 |
Julian |
|
|
|
20.08.2020 12:21:27 |
Gast15656 |
|
|
|
20.08.2020 15:39:15 |
Gast64661 |
|
|
|
20.08.2020 17:44:15 |
Julian |
|
|
|
20.08.2020 18:41:31 |
Gast21876 |
|
|
|
20.08.2020 18:54:01 |
Julian |
|
|
|
20.08.2020 20:36:36 |
Gast77978 |
|
|
|
20.08.2020 18:07:54 |
Gast46785 |
|
|
Binärbaum erstellen mit Mutter-Kind Bez. |
21.08.2020 20:40:49 |
Gast87346 |
|
|
|
21.08.2020 20:46:00 |
Julian |
|
|
Von:
Gast87346 |
Datum:
21.08.2020 20:40:49 |
Views:
770 |
Rating:
|
Antwort:
|
Thema:
Binärbaum erstellen mit Mutter-Kind Bez. |
Würde das weniger kompliziert angehen:
-
nur Verbindungen betrachten
-
Anfang und Ende einer Verbindung als TreeItem merken
-
Optional*: Schema auf Sinnhaftigkeit / Fehler überprüfen
-
Optional: TreeItems in einer Liste zwischenspeichern; z.B. hilfreich wenn man die Schlüssel nach Typen des Teils wählt (z.B. alle Regelklappen) -> man kann direkt zum gew. Teil springen - ohne Namen zu kennen - und von da losrechnen
-
Optional: Sortierung der Liste z.B. nach Kantenlänge (Entfernung von einem Knoten zum Root-Knoten)
'#
'# Klassen-Modul: TreeItem
'#
Option Explicit 'non global or non modular variables used in Subs or funciton have to be declared by dim
Public Parent As TreeItem
Public Shape As Excel.Shape
Public LeftChild As TreeItem 'pointer to the left child node
Public RightChild As TreeItem 'pointer to the right child node
Public Property Get Name() As String
Name = Shape.Name
End Property
Zum Testen:
Sub Test_Call()
Dim objRoot As TreeItem
Dim n As Long
n = GetTree(Worksheets("Tabelle1"), objRoot)
Debug.Print "root-element"; Tab(50); "'"; objRoot.Name; "'"
Debug.Print "root-element::LeftChild"; Tab(50);: Debug.Print "'"; objRoot.LeftChild.Name; "'"
Debug.Print "root-element::LeftChild::LeftChild"; Tab(50);: Debug.Print "'"; objRoot.LeftChild.LeftChild.Name; "'"; " (parent is '"; objRoot.LeftChild.LeftChild.Parent.Name; "')"
End Sub
... und das worums eigentlich geht:
'#
'# Modul: modTree
'#
' VBA-Editor:
' Tools -> References:
' * Microsoft Scripting Runtime
'
Option Explicit
Public Function GetTree(ByVal Worksheet As Excel.Worksheet, ByRef Root As TreeItem) As Long
Dim dicTI As Scripting.Dictionary
Dim shp As Excel.Shape
Set dicTI = New Scripting.Dictionary
For Each shp In Worksheet.Shapes
If shp.Connector Then
With shp.ConnectorFormat
If .BeginConnected Then
If Not dicTI.Exists(.BeginConnectedShape.Name) Then
Set dicTI(.BeginConnectedShape.Name) = New TreeItem
Set dicTI(.BeginConnectedShape.Name).Shape = .BeginConnectedShape
End If
End If
If .EndConnected Then
If Not dicTI.Exists(.EndConnectedShape.Name) Then
Set dicTI(.EndConnectedShape.Name) = New TreeItem
Set dicTI(.EndConnectedShape.Name).Shape = .EndConnectedShape
End If
End If
' Debug.Print "# '"; .BeginConnectedShape.Name; "' is ";
If dicTI(.EndConnectedShape.Name).LeftChild Is Nothing Then
' Debug.Print "LEFT";
Set dicTI(.EndConnectedShape.Name).LeftChild = dicTI(.BeginConnectedShape.Name)
Else
' Debug.Print "RIGHT";
Set dicTI(.EndConnectedShape.Name).RightChild = dicTI(.BeginConnectedShape.Name)
End If
' Debug.Print " child of '"; .EndConnectedShape.Name; "'"
If dicTI(.BeginConnectedShape.Name).Parent Is Nothing Then
Set dicTI(.BeginConnectedShape.Name).Parent = dicTI(.EndConnectedShape.Name)
End If
End With
End If
Next
Set Root = GetRoot(dicTI)
GetTree = dicTI.Count
End Function
Private Function GetRoot(TreeItems As Scripting.Dictionary) As TreeItem
Dim objItem As TreeItem
Set objItem = TreeItems(TreeItems.Keys()(0))
Do Until objItem.Parent Is Nothing
Set objItem = objItem.Parent
Loop
Set GetRoot = objItem
End Function
LG
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
19.08.2020 13:28:59 |
Julian |
|
|
|
19.08.2020 13:47:37 |
Gast30922 |
|
|
|
19.08.2020 14:09:52 |
Julian |
|
|
|
19.08.2020 14:49:37 |
Ralf |
|
|
|
19.08.2020 15:23:14 |
Gast48020 |
|
|
|
19.08.2020 18:50:15 |
Gast96999 |
|
|
|
19.08.2020 19:26:09 |
Julian |
|
|
|
20.08.2020 10:39:56 |
Julian |
|
|
|
20.08.2020 12:21:27 |
Gast15656 |
|
|
|
20.08.2020 15:39:15 |
Gast64661 |
|
|
|
20.08.2020 17:44:15 |
Julian |
|
|
|
20.08.2020 18:41:31 |
Gast21876 |
|
|
|
20.08.2020 18:54:01 |
Julian |
|
|
|
20.08.2020 20:36:36 |
Gast77978 |
|
|
|
20.08.2020 18:07:54 |
Gast46785 |
|
|
Binärbaum erstellen mit Mutter-Kind Bez. |
21.08.2020 20:40:49 |
Gast87346 |
|
|
|
21.08.2020 20:46:00 |
Julian |
|
|