Live-Forum - Die aktuellen Beiträge
Datum
Titel
04.05.2024 20:49:40
Listbox - ausgewählte Zeile aus Tabellenblatt markieren
04.05.2024 16:03:54
Problem mit einer Regel bei bedingter Formatierung
04.05.2024 10:29:31
.Find(what:=..., Lookat:=xlWhole, LookIn:=xlValues) ->For
04.05.2024 09:44:33
Bestimmten bereich aus einem String per VBA separieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1900to1904
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1900to1904
1900to1904
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Artikelliste durchsuchen (rekursiv?)

Artikelliste durchsuchen (rekursiv?)
23.09.2022 16:04:59
JumpY
Hallo,
ich habe ein Problem, bzw. finde nicht die richtige Vorgehensweise für einen folgenden Fall:
Ich habe eine Liste mit ~25000 Zeilen, wo in Spalte A ein Artikel steht und in Spalte B ein Hilfsartikel. Allerdings können für Artikel A unbegrenzt viele Hilfsartikel nötig sein, genauso können für den Hilfsartikel wieder Hilfsartikel benötigt werden. Dann ist der Hilfsartikel nochmal als Artikel in Spalte A vorhanden.
Ich habe hier eine ganz kurze Testversion erstellt, natürlich ist die ansonsten unsortiert, viel länger und teilweise braucht man 50 "Hilfsartikel". Also z.B. Artikel Spalte A benötigt 7 Hilfsartikel, diese 7 brauchen wieder jeweils 3, davon die 3 wieder einen weiteren usw.
Das ganze soll dann wie daneben einfach aufgelistet werden. Besser wäre es sogar noch, wenn es eine Art "Baumstruktur" ergibt. Also gesucher Artikel in A1, direkte Hilfsartikel in B:B, davon die Hilfen widerrum in C:C usw., aber es reicht auch die Ansicht wie dort gezeigt.
Was muss ich dafür nutzen? Ich versuche das auch selber zu erarbeiten, habe aber schon Stunden verbracht. (Sverweis findet nur 1, Index funktioniert irgendwie nicht, mit 100 Hilfsspalten auch doof usw.)
https://www.herber.de/bbs/user/155343.xlsx

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Artikelliste durchsuchen (rekursiv?)
23.09.2022 17:09:33
ChrisL
Hi
Ich lasse die Frage offen, weil es sich nur um einen Ansatz handelt und weil es eine umfangreiche Einarbeitung in die Power-Query (PQ) Materie erfordern würde.
Vor einiger Zeit habe ich mal die nachfolgende Aufgabe gelöst:
https://www.herber.de/bbs/user/150236.xlsx
Unter Input findet sich die Datenbasis, welche Ähnlichkeiten zu deiner Aufgabe ausweist. Ein Apfel benötigt 1 Samen und 3 Wasser. 1 Samen benötigt wiederum 0,1 Wasser.
In der ersten PQ Abfrage "Quelldaten" wird entpivotiert, womit bis auf die Mengenangabe die gleiche Ausgangslage wie bei dir entsteht.
Bei fehlerhafter Quelldatendefinition entsteht eine Endlosschleife (Produkt A benötigt Produkt B und Produkt B benötigt wiederum Produkt A...). Daher ist in der PQ-Funktion eine "Notbremse" nach 20 Loops eingebaut:
if currentLoop >= 20 or...
Falls dich die PQ-Lösung reizt, bin ich dir gerne behilflich, aber du müsstest dich mal einarbeiten z.B.
https://excelhero.de/power-query/power-query-ganz-einfach-erklaert/
Als Alternative sehe ich eigentlich nur VBA (weil 1:n Loops).
cu
Chris
Anzeige
AW: Artikelliste durchsuchen (rekursiv?)
23.09.2022 17:34:08
Daniel
Hi
mal als Ansatz.
Funktionert mit deiner Beispieldatei.
Wie lange es mit deinen Echtdaten rödelt, weiß ich nicht.
Ausgabe wie von dir angegeben. Ich gebe in Spalte H aus, um deine Wunschergebnisse nicht zu überschreiben.

Sub test()
Dim arrQuelle
Dim arrDaten
Dim erg
Dim Ausgabe1, Ausgabe2
Dim i As Long
Dim z As Long
ReDim Ausgabe1(0)
ReDim Ausgabe2(0)
arrQuelle = Cells(1, 1).CurrentRegion
ReDim arrDaten(1 To UBound(arrQuelle, 1) - 1)
For z = 2 To UBound(arrQuelle, 1)
arrDaten(z - 1) = arrQuelle(z, 1) & "|" & arrQuelle(z, 2)
Next
Ausgabe1(0) = ""
Ausgabe2(0) = Range("E1").Value
i = 0
Do
erg = Filter(arrDaten, Ausgabe2(i) & "|", True)
If UBound(erg) >= 0 Then
For z = 0 To UBound(erg)
ReDim Preserve Ausgabe1(UBound(Ausgabe1) + 1)
ReDim Preserve Ausgabe2(UBound(Ausgabe2) + 1)
Ausgabe1(UBound(Ausgabe1)) = Split(erg(z), "|")(0)
Ausgabe2(UBound(Ausgabe2)) = Split(erg(z), "|")(1)
Next
End If
i = i + 1
Loop Until i > UBound(Ausgabe2)
With Range("H3").Resize(UBound(Ausgabe1) + 1, 2)
.Columns(1) = WorksheetFunction.Transpose(Ausgabe1)
.Columns(2) = WorksheetFunction.Transpose(Ausgabe2)
End With
End Sub
Gruß Daniel
Anzeige
AW: Artikelliste durchsuchen (rekursiv?)
23.09.2022 17:37:04
UweD
HAllo
so?

Option Explicit
Sub Hilfsartikel()
Dim TB1 As Worksheet, TB2 As Worksheet
Dim LR As Long, Sp As Integer, Zeile As Long, i As Long
Dim Such As String, C As Variant, firstAddress As String, Start As Long
Set TB1 = Sheets("Tabelle1")
Set TB2 = Sheets("Tabelle2")
Sp = 1
Zeile = 1
Such = InputBox("Suchen nach", "Eingabe", "100-000-001")
'Reset
TB2.Cells.ClearContents
TB1.Rows(1).Copy TB2.Rows(1)
With TB1.Columns(Sp)
'1. Ebene
Set C = .Find(Such, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
LR = TB2.Cells(TB2.Rows.Count, Sp).End(xlUp).Row + 1
With TB2.Cells(LR, Sp)
.Value = C
.Offset(0, 1) = C.Offset(0, 1)
End With
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address  firstAddress
End If
'2.bis x. Ebene
Do
Start = Zeile + 1
Zeile = TB2.Cells(TB2.Rows.Count, Sp).End(xlUp).Row
For i = Start To Zeile
Such = TB2.Cells(i, Sp).Offset(0, 1)
Set C = .Find(Such, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
LR = TB2.Cells(TB2.Rows.Count, Sp).End(xlUp).Row + 1
With TB2.Cells(LR, Sp)
.Value = C
.Offset(0, 1) = C.Offset(0, 1)
End With
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address  firstAddress
End If
Next
Loop While Start
LG UweD
Anzeige
AW: Artikelliste durchsuchen (rekursiv?)
23.09.2022 18:52:36
JumpY
Die beiden Lösungen funktionieren in der Beispieldatei, bei größeren Datenmengen hängt allerdings alles. Vielleicht habe ich aber auch noch einen anderen Fehler eingebaut, das schaue ich noch nach. Ich habe in der "echten" Datei die Daten nämlich in einem eigenen Tabellenblatt "Daten" und in Spalte "A" den Artikel und "E" den Hilfsartikel, aber das lässt sich ja in der Funktion anpassen..
Ich schaue aber auch die PQ-Lösung einmal an.
AW: Artikelliste durchsuchen (rekursiv?)
24.09.2022 16:50:19
UweD
Hier die Anpassung an Spalte A und E

Sub Hilfsartikel()
Dim TB1 As Worksheet, TB2 As Worksheet
Dim LR As Long, SpA As Integer, SpH As Integer, Zeile As Long, i As Long
Dim Such As String, C As Variant, firstAddress As String, Start As Long
Dim Testwert As String
'anpassen#####
Set TB1 = Sheets("Daten")
Set TB2 = Sheets("Ergebnis")
SpA = 1 ' Spalte mit Artikel Hier A
SpH = 5 ' Spalte mit Hilfsartikel Hier E
Testwert = "100-000-001" 'später auskommentieren
'Ende anpassen
Zeile = 1
Such = InputBox("Suchen nach", "Eingabe", Testwert)
'Reset
TB2.Cells.ClearContents
TB1.Rows(1).Copy TB2.Rows(1)
With TB1.Columns(SpA)
'1. Ebene
Set C = .Find(Such, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
LR = TB2.Cells(TB2.Rows.Count, SpA).End(xlUp).Row + 1 ' Erste Freier Zeile
TB2.Cells(LR, SpA) = C
TB2.Cells(LR, SpH) = TB1.Cells(C.Row, SpH)
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address  firstAddress
End If
'2.bis x. Ebene
Do
Start = Zeile + 1
Zeile = TB2.Cells(TB2.Rows.Count, SpA).End(xlUp).Row
For i = Start To Zeile
Such = TB2.Cells(i, SpH)
Set C = .Find(Such, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
LR = TB2.Cells(TB2.Rows.Count, SpA).End(xlUp).Row + 1
TB2.Cells(LR, SpA) = C
TB2.Cells(LR, SpH) = TB1.Cells(C.Row, SpH)
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address  firstAddress
End If
Next
Loop While Start
LG UweD
Anzeige
AW: Artikelliste durchsuchen (rekursiv?)
26.09.2022 11:55:17
Daniel
Hi
nochmal ne Variante, die bei großen Datenmengen etwas schneller sein sollte
wieder passend für die gezeige Beispieldatei, ausgabe ab Spalte H
die Ausgabe erfolgt diesemal nicht untereinander, sondern nebeneinander für jede Ebene.
in der aktuellen Version werden nur die jeweiligen Hilfsartikel ausgegeben (Einspaltiges Ergebnis)
wenn auch zu jedem Hilfsartikel den dazugehörigen übergeordneten Artikel sehen will, muss man die auskommentierten Zeilen wieder aktiv schalten, (alle Zeilen mit e0 oder Erg0, Hochkomma löschen) und den Zähler mit +2 hochzählen statt mit +1.
dann besteht eine Ergebnisebene immer aus zwei Spalten, in der der erste der übergeordnete Artikel, in der zweiten der dazugehörige Hilfsartikel

Sub test()
Dim dic As Object
Dim arr
Dim z As Long
Dim erg(), erg0()
Dim such()
Dim e As String, e0 As String
Dim Spalte As Long
Dim Zähler As Long
Set dic = CreateObject("Scripting.Dictionary")
arr = Cells(1, 1).CurrentRegion
For z = 2 To UBound(arr, 1)
If dic.exists(arr(z, 1)) Then
dic(arr(z, 1)) = dic(arr(z, 1)) & "|" & arr(z, 2)
Else
dic(arr(z, 1)) = arr(z, 2)
End If
Next
Spalte = 8
Zähler = 0
such = Array(Range("E1").Value)
Do
e = "": e0 = "|"
For Each S In such
If dic.exists(S) Then
e = e & "|" & dic(S)
'e0 = e0 & S & String(UBound(Split(dic(S), "|")) + 1, "|")
End If
Next
If e = "" Then Exit Do
e = Mid(e, 2)
'e0 = Mid(e0, 2)
erg = WorksheetFunction.Transpose(Split(e, "|"))
erg0 = WorksheetFunction.Transpose(Split(e0, "|"))
Cells(1, Spalte + Zähler + 1).Resize(UBound(erg, 1), 1) = erg
'Cells(1, Spalte + Zähler + 0).Resize(UBound(erg, 1), 1) = erg0
such = erg
Zähler = Zähler + 1 '+2
If Zähler > 100 Then
MsgBox "Redundanz"
Exit Sub
End If
Loop
End Sub
sollte in der Liste ein Fehler drin sein (Artikel ist sein eingener Hiflsartikel) so entsteht eine Endlosschliefe.
diese wird über die IF-Abfrage am Ende nach einer definierten Anzahl von Durchläufen abgebrochen.
Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige