Schleife für Kombination

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

OK, ich versuche es noch mal zu erklären...
in Spalte B gibt es die Werte L0 bis L10 und sysmbolisieren eine Hierarchie, wobei L0 die oberste Ebene ist. In Spalte E stehen die Namen der jeweiligen Ebene.
Es soll nun die Hierarchie bis zur jeweiligen Ebene gebildet werden, wenn in Spalte D jeweils ein (A) steht, was aber nicht immer der Fall ist.
Wenn z.B. B8 = L5 ist, soll soll in F5 der Bezeichner für die Ebene aus dem Wert aus E neben L0 + dem Wert aus E neben E1 + dem Wert aus E neben E2 usw. die sich darüber befinden gebildet werden.
Es soll aber immer nur direkt darüber nach oben bis zum nächsten L0 gesucht werden und der name gebildet werden.
Weiter unten in der Tabelle können die Namen für L0, L1, L2 usw. anders sein, daher kann keine allgemeine Tabelle genutzt werden, die man Verweisen und dergleichen nutzen könnte...
Ich denke mal dass sich das sicher irgendwie mit VBA realisieren lassen würde, .... leider bin ich diesbezüglich noch blutiger Anfänger....

Hallo,
keinen schimmer ob es so stimmt... aber hier deine Mappe mit button und weiter unten nur Code.
https://www.herber.de/bbs/user/117120.xlsm

Option Explicit
Sub a()
Dim ebenen As Dictionary
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
Set ws = ThisWorkbook.Sheets(1)
With ws
lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
Set rng = .Range(.Cells(2, 2), .Cells(lRow, 2))
Set ebenen = Create_Dictionary(rng)
If ebenen Is Nothing Then Exit Sub
AddValues ebenen, rng
End With
End Sub
Private Function Create_Dictionary(ByVal rng As Range) As Dictionary
Dim tmp As Object
Dim c As Range
Set tmp = New Dictionary
For Each c In rng
If Not tmp.Exists(c.Value) And c.Value  "" Then tmp.Add c.Value, ""
Next c
Set Create_Dictionary = tmp
Set tmp = Nothing
End Function
Private Sub AddValues(ByRef dict As Dictionary, ByVal rng As Range)
Dim c As Range
Dim tmp As String
Dim sameItem As Variant
Dim i As Long
For Each c In rng
tmp = c.Offset(, 3).Value & "|"
If c.Value = sameItem Then
dict(c.Value) = tmp
Else
dict(c.Value) = dict(c.Value) & tmp
End If
sameItem = c.Value
If c.Offset(, 2).Value  "" Then
For i = 0 To GetIndexByKey(dict, c.Value) - 1
c.Offset(, 4).Value = c.Offset(, 4).Value & dict(dict.Keys(i))
Next i
End If
Next c
End Sub
Private Function GetIndexByKey(ByRef dict As Object, ByVal key_ As Variant) As Long
Dim varItem As Variant
For Each varItem In dict.Keys
GetIndexByKey = GetIndexByKey + 1
If varItem = key_ Then Exit Function
Next varItem
End Function

Private Sub AddValues(ByRef dict As Dictionary, ByVal rng As Range) Dim c As Range Dim tmp As String Dim i As Long For Each c In rng tmp = c.Offset(, 3).Value & "|" dict(c.Value) = tmp If c.Offset(, 2).Value "" Then For i = 0 To GetIndexByKey(dict, c.Value) - 1 c.Offset(, 4).Value = c.Offset(, 4).Value & dict(dict.Keys(i)) Next i End If Next c End Sub

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread