Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
1500to1504
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Treeview (Knoten hinzufügen Dynamisch)

Treeview (Knoten hinzufügen Dynamisch)
30.06.2016 10:06:47
baschti007
Hallo ich habe bis jetzt noch nie mit Treeview gearbeitet und würde gerne einen neuen Knoten hinter dem Worksheet(knoten) einfügen der alle gefüllten zellen aus spalte A danach B usw einschließt.
Ich habe hier ein Bsp. gefunden

Die Datei https://www.herber.de/bbs/user/105756.xlsm wurde aus Datenschutzgründen gelöscht


nur das geht nur bis zur dritten Spalte .
Gibt es da ein Möglichkeit diese Dynamisch zu gestallten ?
Gruß Basti

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Treeview (Knoten hinzufügen Dynamisch)
30.06.2016 13:45:32
baschti007
Hallo ich bin immer noch am überlegen wie man eine neue Spalte hinzufügt die dann dort eingelesen wird .
Gruß Basti
Private Sub CommandButton1_Click()
Dim wkb As Workbook, wks As Worksheet
Dim ndeMain As MSComctlLib.node, ndeMain1 As MSComctlLib.node
Dim iCounter As Integer, nAnzahl1 As Long, nAnzahl2 As Long
Dim dic1 As Object, dic2 As Object
Dim sWert1 As String, sWert2 As String, swert3 As String
Set wkb = ThisWorkbook
Set wks = wkb.Worksheets("Autos")
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
With Me.TreeView1
.Nodes.Clear
.LineStyle = tvwRootLines
'Hauptknoten
Set ndeMain = .Nodes.Add(, , Key:=Replace(wkb.Name, " ", "_", 1, -1, vbTextCompare),  _
Text:=wkb.Name)
'ndeMain.Tag = wkb.Name & "~" & wkb.Worksheets(1).Name & "~" & wkb.Worksheets(1).Cells( _
1, 1).Address
With wks
'letzte beschriebene Zeile in Tabelle 'Autos' & Spalte 'A'
nAnzahl1 = wks.Cells(.Rows.Count, 1).End(xlUp).Row
End With
'ab Zeile '3'
For nAnzahl2 = 3 To nAnzahl1
'Spalte 'A'
sWert1 = wks.Cells(nAnzahl2, 1).Value
'Key-Werte im Treeview dürfen kein Leerzeichen enthalten
sWert2 = Replace(sWert1, " ", "_", 1, -1, vbTextCompare)
If Not dic1.exists(sWert2) Then
dic1.Add sWert2, sWert1
Set ndeMain1 = .Nodes.Add(ndeMain.Key, 4, Key:=sWert2, Text:=sWert1)
Else
Set ndeMain1 = .Nodes(sWert2)
End If
ndeMain1.Sorted = True
'Spalte 'B'
sWert1 = wks.Cells(nAnzahl2, 2).Value
'Key-Werte im Treeview dürfen kein Leerzeichen enthalten
sWert2 = Replace(sWert1, " ", "_", 1, -1, vbTextCompare)
If Not dic2.exists(swert3 & "~" & sWert2) Then
dic2.Add swert3 & "~" & sWert2, sWert1
Set ndeMain1 = .Nodes.Add(ndeMain1.Key, 4, Key:=swert3 & "~" & sWert2, Text:= _
sWert1)
Else
Set ndeMain1 = .Nodes(swert3 & "~" & sWert2)
End If
ndeMain1.Sorted = True
'Spalte 'E'
sWert1 = wks.Cells(nAnzahl2, 3).Value
'Key-Werte im Treeview dürfen kein Leerzeichen enthalten
sWert2 = Replace(sWert1, " ", "_", 1, -1, vbTextCompare)
iCounter = iCounter + 1
Set ndeMain1 = .Nodes.Add(ndeMain1.Key, 4, Key:=sWert2 & "~" & iCounter, Text:= _
sWert1)
ndeMain1.Sorted = True
Next nAnzahl2
ndeMain.Expanded = True
ndeMain.Sorted = True
End With
Set ndeMain = Nothing: Set ndeMain1 = Nothing
Set wks = Nothing
Set wkb = Nothing
End Sub

Anzeige
AW: Treeview (Knoten hinzufügen Dynamisch)
30.06.2016 18:06:22
Luschi
Hallo baschti007,
hier mal die Erweiterung um eine weitere Spalte:
https://www.herber.de/bbs/user/106659.xlsm
Gruß von Luschi
aus klein-Paris

AW: Treeview (Knoten hinzufügen Dynamisch)
30.06.2016 19:46:07
Bastian
Hey Luschi
Vielen Dank =)
Jetzt war meine Idee dieses Irgendwie in einer schleife laufen zu lassen nur haben ich keine Ahnung wie ich eine Variabel Defieren kann ?
Ich habe mir das so vorgesellt =)
Private Sub CommandButton1_Click()
Dim wkb As Workbook, wks As Worksheet
Dim ndeMain As MSComctlLib.Node, ndeMain1 As MSComctlLib.Node
Dim iCounter As Integer, nAnzahl1 As Long, nAnzahl2 As Long
'Dim dic1 As Object, dic2 As Object, dic3 As Object, dic4 As Object
Dim sWert1 As String, sWert2 As String, swert3 As String
Set wkb = ThisWorkbook
Set wks = wkb.Worksheets("Autos")
' Set dic1 = CreateObject("Scripting.Dictionary")
'Set dic2 = CreateObject("Scripting.Dictionary")
'Set dic3 = CreateObject("Scripting.Dictionary")
'Set dic4 = CreateObject("Scripting.Dictionary")
'Set dic5 = CreateObject("Scripting.Dictionary")
With Me.TreeView1
.Nodes.Clear
.LineStyle = tvwRootLines
'Hauptknoten
Set ndeMain = .Nodes.Add(, , Key:=Replace(wkb.Name, " ", "_", 1, -1, vbTextCompare),  _
Text:=wkb.Name)
'ndeMain.Tag = wkb.Name & "~" & wkb.Worksheets(1).Name & "~" & wkb.Worksheets(1).Cells( _
1, 1).Address
With wks
'letzte beschriebene Zeile in Tabelle 'Autos' & Spalte 'A'
nAnzahl1 = wks.Cells(.Rows.Count, 1).End(xlUp).Row
End With
'ab Zeile '3'
For nAnzahl2 = 3 To nAnzahl1
' Spalte A bis E
Dim h As Long
For h = 1 To 5
Dim dic(h) As Object
Set dic(h) = CreateObject("Scripting.Dictionary")
sWert1 = wks.Cells(nAnzahl2, 1).Value
If sWert1 = "" Then GoTo Ende
'Key-Werte im Treeview dürfen kein Leerzeichen enthalten
sWert2 = Replace(sWert1, " ", "_", 1, -1, vbTextCompare)
swert3 = sWert2
If Not dic1.exists(sWert2) Then
dic1.Add sWert2, sWert1
Set ndeMain1 = .Nodes.Add(ndeMain.Key, 4, Key:=sWert2, Text:=sWert1)
Else
Set ndeMain1 = .Nodes(sWert2)
End If
ndeMain1.Sorted = True
Next h
'Spalte 'F'
sWert1 = wks.Cells(nAnzahl2, 5).Value
'fehlende Angaben iin der Spalte 'D' nicht verwerten
If Trim(sWert1)  "" Then
'Key-Werte im Treeview dürfen kein Leerzeichen enthalten
swert3 = Replace(sWert1, " ", "_", 1, -1, vbTextCompare)
iCounter = iCounter + 1
Set ndeMain1 = .Nodes.Add(ndeMain1.Key, 4, Key:=sWert2 & "~" & iCounter, Text:= _
sWert1)
ndeMain1.Sorted = True
End If
Ende:
Next nAnzahl2
ndeMain.Expanded = True
ndeMain.Sorted = True
End With
Set ndeMain = Nothing: Set ndeMain1 = Nothing
Set wks = Nothing
Set wkb = Nothing
End Sub

Anzeige
AW: Treeview (Knoten hinzufügen Dynamisch)
30.06.2016 20:38:07
Bastian
Oh ich hab es selber herausgefunden =)
Danke noch mal;)
Private Sub CommandButton1_Click()
Dim wkb As Workbook, wks As Worksheet
Dim ndeMain As MSComctlLib.Node, ndeMain1 As MSComctlLib.Node
Dim iCounter As Integer, nAnzahl1 As Long, nAnzahl2 As Long, nAnzahlS1 As Long, h As Long
Dim dic1 As Object, dic2 As Object ', dic3 As Object, dic4 As Object
Dim sWert1 As String, sWert2 As String, swert3 As String
Set wkb = ThisWorkbook
Set wks = wkb.Worksheets("Autos")
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
'Set dic3 = CreateObject("Scripting.Dictionary")
'Set dic4 = CreateObject("Scripting.Dictionary")
'Set dic5 = CreateObject("Scripting.Dictionary")
With Me.TreeView1
.Nodes.Clear
.LineStyle = tvwRootLines
'Hauptknoten
Set ndeMain = .Nodes.Add(, , Key:=Replace(wkb.Name, " ", "_", 1, -1, vbTextCompare),  _
Text:=wkb.Name)
'ndeMain.Tag = wkb.Name & "~" & wkb.Worksheets(1).Name & "~" & wkb.Worksheets(1).Cells( _
1, 1).Address
With wks
'letzte beschriebene Zeile in Tabelle 'Autos' & Spalte 'A'
nAnzahl1 = wks.Cells(.Rows.Count, 1).End(xlUp).Row
nAnzahlS1 = wks.Cells(3, 256).End(xlToLeft).Column
MsgBox nAnzahlS1
End With
'ab Zeile '3'
For nAnzahl2 = 3 To nAnzahl1
'Spalte 'A'
sWert1 = wks.Cells(nAnzahl2, 1).Value
If sWert1 = "" Then GoTo Ende
'Key-Werte im Treeview dürfen kein Leerzeichen enthalten
sWert2 = Replace(sWert1, " ", "_", 1, -1, vbTextCompare)
swert3 = sWert2
If Not dic1.exists(sWert2) Then
dic1.Add sWert2, sWert1
Set ndeMain1 = .Nodes.Add(ndeMain.Key, 4, Key:=sWert2, Text:=sWert1)
Else
Set ndeMain1 = .Nodes(sWert2)
End If
ndeMain1.Sorted = True
h = 0
' Spalte B bis letzte benutzte  -1
For h = 2 To nAnzahlS1 - 1
sWert1 = wks.Cells(nAnzahl2, h).Value
If sWert1 = "" Then GoTo Ende
'Key-Werte im Treeview dürfen kein Leerzeichen enthalten
sWert2 = Replace(sWert1, " ", "_", 1, -1, vbTextCompare)
If Not dic2.exists(swert3 & "~" & sWert2) Then
dic2.Add swert3 & "~" & sWert2, sWert1
Set ndeMain1 = .Nodes.Add(ndeMain1.Key, 4, Key:=swert3 & "~" & sWert2, Text:= _
sWert1)
Else
Set ndeMain1 = .Nodes(swert3 & "~" & sWert2)
End If
ndeMain1.Sorted = True
Next h
'Spalte 'F'
sWert1 = wks.Cells(nAnzahl2, nAnzahlS1).Value
'fehlende Angaben iin der Spalte 'D' nicht verwerten
If Trim(sWert1)  "" Then
'Key-Werte im Treeview dürfen kein Leerzeichen enthalten
swert3 = Replace(sWert1, " ", "_", 1, -1, vbTextCompare)
iCounter = iCounter + 1
Set ndeMain1 = .Nodes.Add(ndeMain1.Key, 4, Key:=sWert2 & "~" & iCounter, Text:= _
sWert1)
ndeMain1.Sorted = True
End If
Ende:
Next nAnzahl2
ndeMain.Expanded = True
ndeMain.Sorted = True
End With
Set ndeMain = Nothing: Set ndeMain1 = Nothing
Set wks = Nothing
Set wkb = Nothing
End Sub

Anzeige
AW: Treeview (Knoten hinzufügen Dynamisch)
30.06.2016 20:57:28
Bastian
Ok ich war zu voreilig =D
ich muss es doch irgendwie schaffen Set dic2 = CreateObject("Scripting.Dictionary") Variable zu machen hast du eine Idee ?
Gruß Basti

AW: Treeview (Knoten hinzufügen Dynamisch)
02.07.2016 11:38:11
Bastian
Hat wer noch eine Idee zu meinem Problem ? das CreateObject("Scripting.Dictionary") variabel zumachen in einer schleife ?
Freue mich über jede Hilfe =)
Gruß Basti
Schönes Wochenende euch allen .

mit Array
02.07.2016 17:45:48
Michael
Hi,
ich hätte gar nicht gedacht, daß das ohne Klassen und andere Bocksprünge geht, aber es scheint brav hinzuhauen:
Sub test()
Dim aDic() As Object
Dim i&, k&, wert
ReDim aDic(1 To 4)
For i = 1 To 4
Set aDic(i) = CreateObject("scripting.dictionary")
For k = 1 To 5
aDic(i)("Dic Nr. " & i & ": " & k) = "Bla" & k
Next
k = 1
For Each wert In aDic(i).keys
Cells(k, i) = wert & ": " & aDic(i)(wert)
k = k + 1
Next
Next
' hier weitere Aktionen, dann
For i = 1 To 4
Set aDic(i) = Nothing
Next
End Sub
Schöne Grüße,
Michael

Anzeige
Nachtrag: besser OHNE Array
03.07.2016 14:29:24
Michael
Das mit dem Array hatte ich mich interessiert, und es ist auch schön, daß es hinhaut, aber in der Praxis genügt EIN Dictionary völlig: man muß nur den Spaltenbuchstaben vorne dranstellen:
Private Sub Userform_initialize()
Dim wkb As Workbook, wks As Worksheet
Dim ndeMain As MSComctlLib.Node, ndeMain1 As MSComctlLib.Node
Dim i&, SpB$(1 To 20) ' &=as long; SpaltenBuchstabe $=as string
Dim vZ&, bZ&, z&  ' vZ=von Zeile, bZ=bis Zeile, z=Zeilenzähler
Dim vS&, bS&, s&  ' vS, bS, s = von/Spalte, s=Zähler
Dim dic As Object, a   ' Variant, a wie "alles" als Array
'    Dim sW ' Variant, wie "stringWert" als Array
Dim sWert1 As String, sWert2 As String, swert3 As String
'Spaltenbuchstaben bis max. 20 Spalten; geht immer, auch ab "AA"
For i = 1 To 20: SpB(i) = Split(Columns(i).Address(0, 0), ":")(0): Next
vZ = 3
Set wkb = ThisWorkbook
Set wks = wkb.Worksheets("Autos")
a = wks.Range("A" & vZ).CurrentRegion
vZ = LBound(a): bZ = UBound(a): vS = LBound(a, 2): bS = UBound(a, 2)
'    sW = wks.Range("A1").Resize(1, vS)
Set dic = CreateObject("Scripting.Dictionary")
With Me.TreeView1
.Nodes.Clear
.LineStyle = tvwRootLines
'Hauptknoten
Set ndeMain = .Nodes.Add(, , Key:=Replace(wkb.Name, " ", _
"_", 1, -1, vbTextCompare), Text:=wkb.Name)
For z = vZ To bZ
' Die ERSTE Spalte erhält anscheinend eine Sonderbehandlung...
sWert2 = Replace(a(z, vS), " ", "_", 1, -1, vbTextCompare)
swert3 = sWert2
If Not dic.exists(SpB(vS) & sWert2) Then
dic.Add SpB(vS) & sWert2, a(z, vS)
Set ndeMain1 = .Nodes.Add(ndeMain.Key, 4, Key:=sWert2, Text:=a(z, vS))
Else
Set ndeMain1 = .Nodes(sWert2)
End If
ndeMain1.Sorted = True
' Die 2. bis vorletzte sind identisch?!
' nach Bedarf evtl. String-Array verwenden und _
' Einzelteil mit JOIN zusammensetzen?
For s = vS + 1 To bS - 1
sWert1 = a(z, s)
'Key-Werte im Treeview dürfen kein Leerzeichen enthalten
sWert2 = Replace(sWert1, " ", "_", 1, -1, vbTextCompare)
If Not dic.exists(SpB(s) & swert3 & "~" & sWert2) Then
dic.Add SpB(s) & swert3 & "~" & sWert2, sWert1
Set ndeMain1 = .Nodes.Add(ndeMain1.Key, 4, Key:=swert3 & _
"~" & sWert2, Text:=sWert1)
Else
Set ndeMain1 = .Nodes(swert3 & "~" & sWert2)
End If
ndeMain1.Sorted = True
Next
' und die LETZE bekommt auch eine Sonderbehandlung
sWert1 = a(z, bS)
'fehlende Angaben iin der Spalte 'D' nicht verwerten
If Trim(sWert1)  "" Then
'Key-Werte im Treeview dürfen kein Leerzeichen enthalten
swert3 = Replace(sWert1, " ", "_", 1, -1, vbTextCompare)
i = i + 1
Set ndeMain1 = .Nodes.Add(ndeMain1.Key, 4, Key:=sWert2 & _
"~" & i, Text:=sWert1)
ndeMain1.Sorted = True
End If
Next
ndeMain.Expanded = True
ndeMain.Sorted = True
End With
Set ndeMain = Nothing: Set ndeMain1 = Nothing
Set wks = Nothing
Set wkb = Nothing
End Sub

Aha, funktioniert so auch mit 5 Spalten: https://www.herber.de/bbs/user/106705.xlsm
Schöne Grüße,
Michael
P.S.: Danke für die Frage; habe mich auch noch nie mit TreeView beschäftigt.
Abgesehen davon: ein Dic ist eigentlich völlig überflüssig, wenn man die Daten zuvor sortiert: key1=SpalteA bis key(x)=Spalte(x); dann braucht man das nur in ein Array laden und Zeile für Zeile nach Änderungen schauen. Naja, ein Dictionary ist schon sauschnell

Anzeige
AW: Nachtrag: besser OHNE Array
04.07.2016 08:06:20
baschti007
Hey Danke Michael =)
Ich habe nun noch eine Frage wie bekomme ich es hin das das ich soviel Spalten einfügen kann wie ich möchte mit einer Letzten Variante ?
So geht es ja bis zu 5 Spalten.
Gruß Basti

geht auch mit mehr!
04.07.2016 11:40:27
Michael
Hi zusammen,
es geht (vorbehaltlich meiner Unkenntnis des Treeview!) so mit beliebig vielen Spalten.
Innerhalb der äußeren Schleife, die die Zeilen zählt, passiert folgendes:
- die Spalte "A" wird abgearbeitet und damit sWert3 initialisiert
- in einer Schleife werden alle weiteren bis zur vorletzten Spalte abgearbeitet
- dann erst wird die letzte Spalte bearbeitet.
Durch das a = wks.Range("A" & vZ).CurrentRegion werden ALLE Zeilen und Spalten herangezogen, die "zusammenhängen": vZ ist ja mit 3 vorbelegt, d.h. die Referenzzelle ist A3, und alles bis zur nächsten leeren Spalte bzw. leeren Zeilen oben oder unten wird markiert: das kannst Du mal spaßhalber so in Excel testen: A3 anklicken, dann Tastenkombi Strg+Umschalt+* (das * neben dem ü).
Ich habe also nirgends eine feste Spaltenanzahl vorgesehen, es aber nur mit 5 Spalten getestet: weitere Teste überlasse ich gerne Dir...
Schöne Grüße,
Michael

Anzeige
AW: geht auch mit mehr!
05.07.2016 07:00:09
baschti007
Hey Danke Michael =)

gerne, vielen Dank für die Rückmeldung owT
05.07.2016 13:17:49
Michael

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige