Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1852to1856
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

Aufteilung in Array, Zuordung in Spalten

Aufteilung in Array, Zuordung in Spalten
28.10.2021 10:25:08
Robert
Hallo zusammen,
Ich bin neu hier und dies ist mein erster Post. Meine noch bescheidenen VBA-Kenntnisse habe ich mir überwiegend in diesem Forum angeeignet.
In Spalte A stehen Artikelnamen. Die Artikelnamen bestehen aus bis zu 9 Bestandteilen, getrennt durch Leerzwichen. Die Reihenfolge dieser Bestandteile kann variiren.
Diese Artikelnamen sollen nun in Ihre Bestandteile aufgeteilt werden. Diese Bestandteile sollen dann zur weiteren Verwendung/Bearbeitung in jeweils bestimmte Spalten C:J eingetragen werden. So soll in Spalte J die Farbe stehen.
Probleme:
- Auch wenn es wahrscheinlich nicht schön gelöst ist von mir, klappt es so weit. Ist aber offenbar sehr fehleranfällig.
- So kommt es in Zeile 6044-6058, z.B. dem Artikelnamen "Mini C K W black" zu einem Konflikt ("Doppeldeutung") Da es sowohl einen Bestandteil "C" aber auch den Bestandteil "Mini C" gibt. Das "C" gehört hier aber nur zu "Mini C".
- Ein Bestandteil, ein String wie "60.80" wird als "60,8" in die Spalte übertragen. Bisher habe ich dies mit einer vorherigen Formatierung der Spalte gelöst.
Eigentlich wollte ich dies rein über Arrays machen und dann das Ergebnis in einem Schwung in die Spalten C:J eintragen. Da muss ich aber noch mehr lernen. Es sind bis zu 20.000 Datensätze mit bis zu 9 Bestandteilen und später sollen in einem weiteren Schritt 2 solche Tabellen abgeglichen werden um neue Datensätze und bereits vorhandene Datensätze zu finden und zu markieren (Eintrag in weiterer Spalte). Das ist der Grund warum ich mich für Arrays entschieden habe.
Der Makro läuft bei mir zwischen 30 und 90 Sekunden.
Ich würde mich sehr über Hilfe und eine Erweiterung meines VBA-Horizontes freuen. Sollte ich was falsch gemacht haben und nicht regelkonform agiert haben, bitte ich vielmals um Entschuldigung und freue mich auf einen entsprechenden Hinweis.
Ich danke Euch vielmals im Voraus!
Mit besten Grüßen
Robert
https://www.herber.de/bbs/user/148833.xlsb
Mein Code:
Option Explicit

Sub Erste_Aufteilung()
' ***** Timer-Funktion START
Dim StartingTime1 As Single
StartingTime1 = Timer
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.Calculation = xlCalculationManual
Worksheets("Tabelle1").Activate
' ***** Zelladresse, erstes Finden
Dim strAdr01 As String, strAdr02 As String, strAdr03 As String, strAdr04 As String, strAdr05 As String, _
strAdr06 As String, strAdr07 As String, strAdr08 As String
' ***** Zelladresse, nächstes Finden
Dim rngTreffer01 As Range, rngTreffer02 As Range, rngTreffer03 As Range, rngTreffer04 As Range, rngTreffer05 As Range, _
rngTreffer06 As Range, rngTreffer07 As Range, rngTreffer08 As Range
' ***** in A:A zu suchende Werte
Dim VarDat01 As Variant, VarDat02 As Variant, VarDat03 As Variant, VarDat04 As Variant, VarDat05 As Variant, _
VarDat06 As Variant, VarDat07 As Variant, VarDat08 As Variant
' ***** Position im jeweiligen Array
Dim lngZ01 As Long, lngZ02 As Long, lngZ03 As Long, lngZ04 As Long, lngZ05 As Long, _
lngZ06 As Long, lngZ07 As Long, lngZ08 As Long
' ***** ARRAY defginition, Suchbegriffe für Spalten C:J
VarDat01 = Array("black", "white", "graphite", "snow-white", "grey", "black/copper", "black/gold", "black/rose", "black/rose-gold", "black/snow-white", "snow-white/black")
VarDat02 = Array(" PR ", " SOFT ", " SPR ")
VarDat03 = Array(" DALI ", " ON/OFF ", " PUSH-DIM ", " TRIAC ")
VarDat04 = Array(" N ", " NW ", " SN ", " SNW ", " SW ", " W ")
VarDat05 = Array(" F ", " IN ", " K ", " ON ", " T ", " TRC ", " Z ", " ZS ")
VarDat06 = Array(" II ", " L ", " R ", " V ", " X ")
VarDat07 = Array(" 10 ", " 13 ", " 14 ", " 15 ", " 20 ", " 25 ", " 30 ", " 40 ", " 45 ", " 50 ", " 60 ", " 65 ", " 70 ", " 90 ", " 100 ", " 110 ", " 120 ", " 136 ", " 150 ", _
" 160 ", " 240 ", " 250 ", " 300 ", " 136I ", " 136II ", " 160I ", " 160II ", " A ", " B ", " C ", " D ", " E ", " L ", " L11 ", " L111 ", " L21 ", " L31 ", " M ", " R ", " R11 ", " R111 ", " R21 ", " R31 ", " V ", " XL ", " XXL ")
VarDat08 = Array("60.80 ", "Accent ", "Accent RT ", "Ambiente ", "Backlight ", "Backlight+ ", "Beep ", "Beep-Care ", "Box ", "Coro ", "Cubic ", "Cubic-Slim ", "D ", "D-Bay ", "D+ ", "Danse ", _
"Firefly ", "Flask ", "Fusion ", "Fusion RT ", "Grand ", "Hello ", "Illu ", "Luna-Llena ", "Luno ", "Maia ", "Maman R ", "Maxime ", "Maxime R ", "MBox ", "MFusion ", "Mini C ", "Minus ", "Moi ", _
"Moi C ", "Moi R ", "Moonlight ", "Myco ", "Myco-One ", "Ocu ", "Optique ", "Orionis ", "Otel ", "PDX ", "Plus", "Pick-Me ", "Qua+ ", "Qua+ R ", "Ra ", "Ra-Mini ", "Reel ", "Reel+ ", "Slim-Line+ ", _
"Subtil ", "Telescope ", "Thiny-Slim ", "Thiny-Slim RT ", "Thiny-Slim+ ", "Thiny-Snake ", "Tonic ", "Vectris ", "Vectris+ ")
Dim maxRow As Integer
maxRow = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row
' ***** Code für letzte Spalte J:J
For lngZ01 = LBound(VarDat01) To UBound(VarDat01)
Set rngTreffer01 = Range("A1:A" & maxRow).Find(What:=VarDat01(lngZ01), LookAt:=xlPart)
If Not rngTreffer01 Is Nothing Then
strAdr01 = rngTreffer01.Address
Do
rngTreffer01.Offset(, 9) = VarDat01(lngZ01)
Set rngTreffer01 = Range("A1:A" & maxRow).FindNext(rngTreffer01)
Loop While Not rngTreffer01 Is Nothing And rngTreffer01.Address  strAdr01
End If
Next lngZ01
For lngZ02 = LBound(VarDat02) To UBound(VarDat02)
Set rngTreffer02 = Range("A1:A" & maxRow).Find(What:=VarDat02(lngZ02), LookAt:=xlPart)
If Not rngTreffer02 Is Nothing Then
strAdr02 = rngTreffer02.Address
Do
rngTreffer02.Offset(, 8) = VarDat02(lngZ02)
Set rngTreffer02 = Range("A1:A" & maxRow).FindNext(rngTreffer02)
Loop While Not rngTreffer02 Is Nothing And rngTreffer02.Address  strAdr02
End If
Next lngZ02
For lngZ03 = LBound(VarDat03) To UBound(VarDat03)
Set rngTreffer03 = Range("A1:A" & maxRow).Find(What:=VarDat03(lngZ03), LookAt:=xlPart)
If Not rngTreffer03 Is Nothing Then
strAdr03 = rngTreffer03.Address
Do
rngTreffer03.Offset(, 7) = VarDat03(lngZ03)
Set rngTreffer03 = Range("A1:A" & maxRow).FindNext(rngTreffer03)
Loop While Not rngTreffer03 Is Nothing And rngTreffer03.Address  strAdr03
End If
Next lngZ03
For lngZ04 = LBound(VarDat04) To UBound(VarDat04)
Set rngTreffer04 = Range("A1:A" & maxRow).Find(What:=VarDat04(lngZ04), LookAt:=xlPart)
If Not rngTreffer04 Is Nothing Then
strAdr04 = rngTreffer04.Address
Do
rngTreffer04.Offset(, 6) = VarDat04(lngZ04)
Set rngTreffer04 = Range("A1:A" & maxRow).FindNext(rngTreffer04)
Loop While Not rngTreffer04 Is Nothing And rngTreffer04.Address  strAdr04
End If
Next lngZ04
For lngZ05 = LBound(VarDat05) To UBound(VarDat05)
Set rngTreffer05 = Range("A1:A" & maxRow).Find(What:=VarDat05(lngZ05), LookAt:=xlPart)
If Not rngTreffer05 Is Nothing Then
strAdr05 = rngTreffer05.Address
Do
rngTreffer05.Offset(, 5) = VarDat05(lngZ05)
Set rngTreffer05 = Range("A1:A" & maxRow).FindNext(rngTreffer05)
Loop While Not rngTreffer05 Is Nothing And rngTreffer05.Address  strAdr05
End If
Next lngZ05
For lngZ06 = LBound(VarDat06) To UBound(VarDat06)
Set rngTreffer06 = Range("A1:A" & maxRow).Find(What:=VarDat06(lngZ06), LookAt:=xlPart)
If Not rngTreffer06 Is Nothing Then
strAdr06 = rngTreffer06.Address
Do
rngTreffer06.Offset(, 4) = VarDat06(lngZ06)
Set rngTreffer06 = Range("A1:A" & maxRow).FindNext(rngTreffer06)
Loop While Not rngTreffer06 Is Nothing And rngTreffer06.Address  strAdr06
End If
Next lngZ06
For lngZ07 = LBound(VarDat07) To UBound(VarDat07)
Set rngTreffer07 = Range("A1:A" & maxRow).Find(What:=VarDat07(lngZ07), LookAt:=xlPart)
If Not rngTreffer07 Is Nothing Then
strAdr07 = rngTreffer07.Address
Do
rngTreffer07.Offset(, 3) = VarDat07(lngZ07)
Set rngTreffer07 = Range("A1:A" & maxRow).FindNext(rngTreffer07)
Loop While Not rngTreffer07 Is Nothing And rngTreffer07.Address  strAdr07
End If
Next lngZ07
For lngZ08 = LBound(VarDat08) To UBound(VarDat08)
Set rngTreffer08 = Range("A1:A" & maxRow).Find(What:=VarDat08(lngZ08), LookAt:=xlPart)
If Not rngTreffer08 Is Nothing Then
strAdr08 = rngTreffer08.Address
Do
rngTreffer08.Offset(, 2) = VarDat08(lngZ08)
Set rngTreffer08 = Range("A1:A" & maxRow).FindNext(rngTreffer08)
Loop While Not rngTreffer08 Is Nothing And rngTreffer08.Address  strAdr08
End If
Next lngZ08
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.Calculation = xlCalculationAutomatic
' ***** Timer-Funktion STOP
Debug.Print "Benötigte Zeit: " & Format((Timer - StartingTime1) / 86400, "hh:mm:ss") & " Minuten."
Debug.Print " "
End Sub

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Aufteilung in Array, Zuordung in Spalten
28.10.2021 12:56:24
Yal
Hallo Robert,
zuerst Respekt, dass Du auf Grund von unserem Forum-G'schwätz so weit gebracht hast.
Lösung Doppeldeutung:
immer zuerst den längste Treffer prüfen, dann aussteigen: "Moi C" vor "Moi", "SNW" vor "SN" oder "NW", "60.80" von "60" usw. Im allgemein: in absteigende alphabetische Reihenfolge.
Aussteigen bedeutet: innerhalb einer Liste nicht mehr weitersuchen und das Gefundenen aus der zu durchsuchende Basis rausnhemen: "SWN" in "x SWN y" gefunden, dann "x y" übrig lassen, sonst wird "WN" darin gefunden.
Dementsprechend die Reihenfolge der innerhalb Liste anpassen.
Dementsprechend die Reihenfolge untereinander austauschen.
Lösung "60.80":
die Zielspalte muss als Textspalte formatiert sein.
Lösung Geschwindigkeit:
den "Find" ist zwar performant, aber wenn Du von vorne rein weisst, dass Du über alle Einträge durchlaufen muss, lieber mit For-Schleife.
Lösung Lesbarkeit:
was sich wiederholt solte abgelagert werden und mit Parameter angesprochen werden.
So sieht mein Entwurf aus. Läuft bei deinem Beispiel in 3 Sek.

Sub Erste_Aufteilung()
Dim StartingTime1 As Single
Dim VarDat(1 To 8) As String
Dim Z As Range
Dim RestText As String
StartingTime1 = Timer
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.Calculation = xlCalculationManual
' ***** ARRAY defginition, Suchbegriffe für Spalten C:J
VarDat(1) = "white;snow-white/black;snow-white;grey;graphite;black/snow-white;black/rose-gold;black/rose;black/gold;black/copper;black"
VarDat(2) = "SOFT;SPR;PR"
VarDat(3) = "DALI;ON/OFF;PUSH-DIM;TRIAC"
VarDat(4) = "SNW;SN;NW;SW;W;N"
VarDat(5) = "F;IN;K;ON;TRC;T;ZS;Z"
VarDat(6) = "II;L;R;V;X"
VarDat(7) = "XXL;XL;V;R31;R21;R111;R11;R;M;L31;L21;L111;L11;L;E;D;C;B;A;160II;160I;136II;136I;300;250;240;160;150;136;120;110;100;90;70;65;60;50;45;40;30;25;20;15;14;13;10"
VarDat(8) = "Vectris+;Vectris;Tonic;Thiny-Snake;Thiny-Slim+;Thiny-Slim RT;Thiny-Slim;Telescope;Subtil;Slim-Line+;Reel+;Reel;Ra-Mini;Ra;Qua+ R;Qua+;Plus;Pick-Me;PDX;Otel;Orionis;Optique;Ocu;Myco-One;Myco;Moonlight;Moi R;Moi C;Moi;Minus;Mini C;MFusion;MBox;Maxime R;Maxime;Maman R;Maia;Luno;Luna-Llena;Illu;Hello;Grand;Fusion RT;Fusion;Flask;Firefly;D-Bay;Danse;D+;D;Cubic-Slim;Cubic;Coro;Box;Beep-Care;Beep;Backlight+;Backlight;Ambiente;Accent RT;Accent;60.80"
With ThisWorkbook.Worksheets("Tabelle1")
For Each Z In .Range(.Range("A2"), .Range("A99999").End(xlUp)).Cells
RestText = Z.Value 'Initialisierung
RestText = Rausholen(RestText, VarDat(8), "C" & Z.Row) ' VarDat08 --> C
RestText = Rausholen(RestText, VarDat(7), "D" & Z.Row) ' VarDat07 --> D
RestText = Rausholen(RestText, VarDat(1), "J" & Z.Row) ' VarDat01 --> Spalte A + 9 = 10 = J
RestText = Rausholen(RestText, VarDat(3), "H" & Z.Row) ' VarDat03 --> A + 7 = 8 = H
RestText = Rausholen(RestText, VarDat(5), "F" & Z.Row) ' VarDat05 --> F
RestText = Rausholen(RestText, VarDat(4), "G" & Z.Row) ' VarDat04 --> G
RestText = Rausholen(RestText, VarDat(6), "E" & Z.Row) ' VarDat06 --> E
RestText = Rausholen(RestText, VarDat(2), "I" & Z.Row) ' VarDat02 --> A + 8 = 9 = I
Next Z
End With
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.Calculation = xlCalculationAutomatic
' ***** Timer-Funktion STOP
Debug.Print "Benötigte Zeit: " & Format((Timer - StartingTime1) / 86400, "hh:mm:ss") & " Minuten."
Debug.Print " "
End Sub
Private Function Rausholen(RestText As String, VarDat As String, Adresse As String)
Dim E
Const L = " "
Rausholen = Trim(RestText)  'Default, falls kein Treffer
RestText = L & RestText & L 'Leerzeichen vor und hinten
For Each E In Split(VarDat, ";")
If InStr(1, RestText, L & E & L, vbTextCompare) Then
ThisWorkbook.Worksheets("Tabelle1").Range(Adresse) = E 'Schreiben in Spalte J der akt. Zeile
Rausholen = Trim(Replace(RestText, E, "")) 'Treffer rausnehmen
Exit For 'ich gehe davon, wenn ein Farbe dann keine andere
End If
Next
End Function
VG
Yal
Anzeige
AW: Aufteilung in Array, Zuordung in Spalten
28.10.2021 15:45:19
Robert
Hallo Yal,
erst einmal vielen herzlichen Dank für die prompte Antwort und den sehr professionellen und raffinierten Ansatz!! Danke auch für Dein Kompiment - ich bemühe mich - aber welches natürlich durch Deinen smarten Ansatz gleichzeitig wieder relativiert wird. Da bin ichich noch ganz weit weg. Aber wirklich ein großes Danke.
Ich habe es mir durchgelesen und etwas durchgearbeitet. Ich muss es mir aber wirklich noch verinnerlichen. Aber eben auch das Ergebnis sieht sehr gut aus. Ich lasse es nun mit 20.000 Datensätzen durchlaufen.
Jetzt muss ich nur noch sehen wie fehlerresistent dieser Ansatz in Anhängigkeit der VarDat(i), ihrer Reihenfolge und Inhalte - Dein "Dementsprechend die Reihenfolge der innerhalb Liste anpassen." und Dein "Dementsprechend die Reihenfolge untereinander austauschen." ist. Aber ein sehr toller Ansatz. Bin schwer begeistert.
Du hast Recht, es wird nur eine Farbe zugelassen.
Diese, Deine Vorgehensweise, "Filetieren" und "Rausschneiden" wäre dies auch mit/in einem Array möglicg gewesen? Würde dies mit Array überhaupt einen (Geschwindigkeits-)Vorteil oder Handlingsvorteil bieten?
Da ich im nächsten Schritt dann 2 verschiedene Tabellen gleicher Struktur, z.B. DatenALT und DatenNEU wie diese haben werde, nur mit Artikelnamen in A:A wie diese, kann man diesen Ansatz denn auch verwenden, um in Spalte C:C dann z.B. zu notieren: "Datensatz in anderer Tabelle bereist vorhanden" oder "z.B. "Datensatz neu"?
Dabei muss die Reihenfolge der einzelnen Bestandteile egal sein können. Fehlt ein Bestandteil im Artikelnamen oder ist ein Bestandteil mehr vorhanden, dann ist dies ein neuer Artikel.
Vielleicht hast Du einen Tipp, wie ich mit diesem Abgleich in Zukunft umgehen könnte?
Aber an dieser Stelle noch einmal ein großes Dankeschön! Ich werde noch etwas brauchen, um diesen smarten Ansatz zu verinnerlichen.
Beste Grüße
Robert
Anzeige
AW: Aufteilung in Array, Zuordung in Spalten
28.10.2021 16:21:20
Yal
Hallo Robert,
Vielen Dank für die Wertschätzung. In der Lösung ist natürlich Wissen reingeflossen, aber vor allem viele Erfahrung. Je schmerzhafter diese gemacht wird, desto schneller wird gelernt :-)
Wichtig ist, dass Du schon den Prinzip verstanden hast: suche nicht zuerst "ab" und dann "abc" sondern zuerst "abc" und nehme es weg, sodass darin nicht "ab" gefunden wird (dass mit der Farbe ist nur einen Beispiel davon).
Die Reihenfolge ist davon abhängig, ob eine Zeichenkette Unterteil von einer anderen ist. Dafür gibt es auch Algorythmen ;-)
Ich habe dementsprechend deine Liste alphabetisch (Z-A) sortiert. Aber es bringt nicht die Sicherheit, dass es kein "Beisser" gibt. Beim Laufen lassen habe ich verschiedene Versuche, sodass mit der Reihenfolge (innerhalb der For-Schleife) 8-7-1-3-5-4-6-2 ein einigermassen gutes Ergebnis erzielt werden kann. Ein Messgrösse der "Qualität" könnte die Anzahl der extrahierten Teile sein (=Anzahl2(C2:J7000).
Die Trennung in 2 Richtung: 1. Suche in eine Liste, 2. Reihenfolge der Liste macht das Ergebnis unsicher. Besser wäre noch, wenn alle Element in eine einzige Liste vorhanden wäre, aber für jeden Element die Informationstyp ("der geht in Spalte C, der in F, Der in ...) daneben liegen würde. Dies Einträge könnten in einer Excel-Blatt vorliegen.
Es macht übrigens keine Unterschied, ob Array oder Semikolon-getrennte Zeichenkette. Letzteres sieht im Code sauberer, als Liste in einem Blatt, wäre es de facto einen Array. In der Sub "rausholen" wird aus der Kette ein Array (Split(x, ";")) für den For Each gemacht. Die wesentliche Performancegewinn liegt in die Vermeidung der Suche ("Find"), der Absprung, wenn etwas gefunden wird (ca. 50%) und dass der geprüfte Text immer kleiner wird.
Die Prüfung ist übrigens Gross/Klein-Unabhägig (vbTextCompare). Sollte nur eine untergeordnete Rolle spielen.
Ich hoffe, es kann Dir zu die perfekte Lösung helfen. Mir hat es Spass gemacht, mal was anderes als "wie kopieren das von hier nach da".
VG
Yal
Anzeige
Abgleich von 2 Arrays nach Split der Strings
30.10.2021 12:32:09
2
Hallo Yal,
ich möchte Dir noch einmal ein Feedback geben. Dein genialer Code klappt wunderbar, lässt aber bei größeren Datenmengen doch, auch wenn nur ganz, ganz wenige "unrichtig" durchgehen. Der entscheidende Punkt ist, dass dann die Nachkontrolle zu umfangreich ist.
Daher meine Frage an Dich, ob ich Dich noch einmal "belästigen" darf?
Damit Du nicht in dem alten Thread nachschauen musst, fasse ich noch mal zusammen:
Ich möchte Artikelbezeichnungen in 2 Datenquellen, in Spalte A (Daten ALT) und in Spalte D (Daten NEU) miteinander vergleichen.
Die Artikelbezeichnungen bestehen aus 4 bis zu 9 verschiedenen Teilen (Strings). Diese Teile sind durch Leerzeichen getrennt.
Ich habe die Artikelbezeichnungen aus Spalte A in die Bestandteile gesplittet, in ein ersten Array (Daten ALT) und
die Artikelbezeichnungen aus Spalte D in die Bestandteile gesplittet und in ein zweites Array (Daten NEU) geschrieben. Beide Array sind vollkommen unabhängig voneinander.
So weit schaffe ich das.
Nun möchte ich diese beiden Arrays abgleichen. In Spalte B und/oder Spalte E soll ein Vermerk in der entsprechenden Zeile erscheinen, ob diese Artikelbezeichnung in dem jeweils anderen Array vorhanden ist. Zum Beispiel, bei Daten NEU entweder "neu" oder "ok". Bei Daten ALT entweder die "Zeile xy" oder "nicht vorhanden".
Die Artikelnamen sind dann identisch wenn sie:
1. dieselben Bestandteile haben,
2. dieselbe Anzahl von Bestandteilen besitzen,
3. auch wenn die Reihenfolge dieser Bestandteile unterschiedlich ist.
Es sind je Datenquelle 15.000 bis 20.000 Zeilen. Durch die Benutzung von Arrays verspreche ich mir Geschwindigkeitsvorteile. Gleichzeitig vermute ich auch einen hohen Rechenaufwand. Mit Instr bekomme ich die Trennschärfe bestimmt nicht mit Sicherheit hin. Ich als VBA-Laie denke da eher an einen = Operator oder eine match-Funktion. Aber wie gesagt, ich bin Laie.
Diesen Abgleich kann ich nicht. Weißt Du eine Lösung?
Vielen Dank im Voraus und ich wünsche Dir noch ein tolles Wochenende.
Beste Grüße
Robert
Mein Code:
https://www.herber.de/bbs/user/148870.xlsb

Sub ZweiArraysAbgleichen()
Tabelle3.Activate
'***** 1. Array Daten ALT
Dim ZelleALT As String
Dim splitStringALT() As String
Dim myDataArrayALT(1 To 20, 1 To 9) As String
Dim iALT As Integer, jALT As Integer
Dim laRowALT As Integer
laRowALT = Range("A1", Range("A2").End(xlDown)).Rows.Count
'            'Split strings to arrayALT including TRIM and CLEAN functions
For iALT = 1 To laRowALT
ZelleALT = WorksheetFunction.Clean(WorksheetFunction.Trim(Range("A" & iALT + 1).Value2))
splitStringALT = Split(ZelleALT, " ")
For jALT = 0 To UBound(splitStringALT)
myDataArrayALT(iALT, jALT + 1) = splitStringALT(jALT)
Next
Next
'***** 2. Array Daten NEU
Dim ZelleNEU As String
Dim splitStringNEU() As String
Dim myDataArrayNEU(1 To 4, 1 To 9) As String
Dim iNEU As Integer, jNEU As Integer
Dim laRowNEU As Integer
laRowNEU = Range("D1", Range("D2").End(xlDown)).Rows.Count
'Split strings to arrayNEU including TRIM and CLEAN functions
For iNEU = 1 To laRowNEU
ZelleNEU = WorksheetFunction.Clean(WorksheetFunction.Trim(Range("D" & iNEU + 1).Value2))
splitStringNEU = Split(ZelleNEU, " ")
For jNEU = 0 To UBound(splitStringNEU)
myDataArrayNEU(iNEU, jNEU + 1) = splitStringNEU(jNEU)
Next
Next
'**** Hier sollte nun der Abgleich erfolgen und in Spalte B und oder E eine Meldung erfolgen, _
ähnlich der bestehenden Anmerkungen in Spalte F ob der Artikelname _
aus D (2. Array Daten NEU) in A (1. Array Daten ALT) gefunden wurde.
End Sub

Anzeige
AW: Abgleich von 2 Arrays nach Split der Strings
30.10.2021 23:52:45
2
Hallo Tech,
Ein solcher Vergleich geht an einfachsten mit Power Query. Es wird damit, was man in Datenbanken einen Join nennt, gemacht.
Markiere deine erste Tabelle "Alt" und wähle "Einfügen", "Tabelle". Diese Tabelle wird Tabelle1 automatisch benannt.
Gehe auf "Daten", Abfragen "aus Tabelle", es öffnet sich Power Query.
Wir gehen aber sofort wieder raus mit "Schließen und laden" wählen aber "Schließen und laden in..." Und nehmen die Option "nur Verbindung".
Wir machen das gleiche mit der Liste "Neu", bleiben aber in Power Query.
Wir nehmen die Funktion "Abfrage zusammenfügen", wählen in der erste Tabelle die Spalte Artikelname, setzen die zweite Tabelle im unteren Bereich und wählen dort auch den Artikelname, dann wählen wir den Join Typ. Da bin ich unschlüssig, was für am besten helfen kann. Musst Du probieren (ich glaube outer Join. Bin gerade nicht am Rechner).
Anschließend musst Du die erzeugte Spalte erweitern (die Pfeilen in Kopfbereich, die auseinander gehen). Dann mehrere Benutzerdefinierte Spalten einfügen mit einer Vergleichsformel pro Extrakt
=[Var1]=[Tabelle2.Var1]
(Je nach dem deine Spalte Grüßen)
Und mit Filter prüfen, da wo die Werte ungleich sind.
Hier kannst Du "Schließen und laden in..." und "Tabelle" anstatt "nur Verbindung". Dann hast du die Vergleichsliste in Excel.
Ich habe das Thema "in welcher Reihenfolge sollten sie Treffer getestet werden" noch überlegt: umgekehrte alphabetische Reihenfolge ist nur innerhalb einer Gruppe richtig. Ideal wäre, alle einzelne Eintrag hätte die Zielspalte neben sich. Dann könnte man alle Einträge prüfen, in wie weit diese in einen anderen vorhanden wäre (NW ist in SNW drin) und so eine absolute Reihenfolge definieren: erst SNW dann NW. Da die Einträge die Zielspalte bei sich haben, hätten wir nicht 8 Gruppen, sondern nur eine.
Vielleicht nehme ich mir Zeit, und diese Sortierung zu algorithmisieren. Aber nicht jetzt ;-)
VG
Yal
Anzeige
AW: Abgleich von 2 Arrays nach Split der Strings
31.10.2021 12:54:16
2
Hallo Yal,
danke Dir sehr herzlich für Deine Antwort.
Mit Power Query hatte ich bisher noch fast nichts zu tun. Wird aber auch mal Zeit :-)
Das schaue ich mir direkt ab morgen mal an.
Auch Deine "Algorithmisierung" wäre ich gespannt, wie Du das bewerkstelligen wollen würdest. Ich dachte eigentlich, ich stecke alles über SPLIT in Arrays, wie hier geschehen" und suche dann z.B. über mehrere Abfragen in einem Produkt á la
Übereinstimmung1 * Übereinstimmung2 * ... * ÜbereinstimmungN > 0
die Treffer. Wobei die einzelnen ÜbereinstimmungX-Funktionen, eine Funktion mit Rückgabewert 0 oder größere 0 sind. Ist eine ÜbereinstimmungX-Funktion = 0, existiert auch kein Treffer, da das ganze Produkt = 0. Benutze ich bei einfacheren Dingen.
Z.B. liefert die Instr-Funktion einen solchen Rückgabewert in einer Übereinstimmung.
Aber offenbar habe ich zu einfach gedacht. Und wahrscheinlich würden wir/ich das gleiche Problem mit der "Trennschärfe" haben.
Ich wünsche Dir noch einen tollen Sonntag. Ich schaue mir das dann ab morgen mal an.
Und nochmal bitte einen großen Dank an Dich für Deine Zeit und Deine Erfahrung!
Robert
Anzeige
AW: Abgleich von 2 Arrays nach Split der Strings
01.11.2021 01:43:44
2
Hallo Robert,
Du hast ja ein Glück: ganze Familie ist irgendwo unterwegs, bin allein und gelangweilt!
Algo: eigentlich reicht es fast, wenn man nach länge sortiert. Ein Begriff mit 5 Buchstaben kann nicht in einem mit 4 enthalten sein.
Mit folgendem Code werden alle Einträge in Spalte A des gegebenen Blattes herausgegeben und in Spalte B die Zielspalte C bis J.
Setze davor den Format von Spalte A auf "Text". Sonst musst Du anschliessend den 60,8 in 60.80 korrigieren

Sub Herausgeben()
Dim VarDat(1 To 8)
Dim I, E, R
Dim W As Worksheet
Const Spalten = "_;J;I;H;G;F;E;D;C"
VarDat(1) = "white;snow-white/black;snow-white;grey;graphite;black/snow-white;black/rose-gold;black/rose;black/gold;black/copper;black"
VarDat(2) = "SOFT;SPR;PR"
VarDat(3) = "DALI;ON/OFF;PUSH-DIM;TRIAC"
VarDat(4) = "SNW;SN;NW;SW;W;N"
VarDat(5) = "F;IN;K;ON;TRC;T;ZS;Z"
VarDat(6) = "II;L;R;V;X"
VarDat(7) = "XXL;XL;V;R31;R21;R111;R11;R;M;L31;L21;L111;L11;L;E;D;C;B;A;160II;160I;136II;136I;300;250;240;160;150;136;120;110;100;90;70;65;60;50;45;40;30;25;20;15;14;13;10"
VarDat(8) = "Vectris+;Vectris;Tonic;Thiny-Snake;Thiny-Slim+;Thiny-Slim RT;Thiny-Slim;Telescope;Subtil;Slim-Line+;Reel+;Reel;Ra-Mini;Ra;Qua+ R;Qua+;Plus;Pick-Me;PDX;Otel;Orionis;Optique;Ocu;Myco-One;Myco;Moonlight;Moi R;Moi C;Moi;Minus;Mini C;MFusion;MBox;Maxime R;Maxime;Maman R;Maia;Luno;Luna-Llena;Illu;Hello;Grand;Fusion RT;Fusion;Flask;Firefly;D-Bay;Danse;D+;D;Cubic-Slim;Cubic;Coro;Box;Beep-Care;Beep;Backlight+;Backlight;Ambiente;Accent RT;Accent;60.80"
With thisworkbooks.Worksheets("Tabelle1")
For I = 1 To 8
For Each E In Split(VarDat(I), ";")
W.Range("A99999").End(xlUp).Range("A2:B2") = Array(E, Split(Spalten, ";")(I))
Next
Next
End With
End Sub
Es sind 145 Einzeleinträge.
Dann setze über diese Spalten in A "Wort", in B "Zielspalte", und wenn wir schon dabei sind: Spalte C "Länge" und D "Test".
Setze auf diese Spalten einen Filter: "Start", "Sortieren und Filtern", "Filtern"
Sortiere damit die Spalte A alphabetisch
Setze in C2 die Formel =Länge(A2), erweitere diese Formel bis Zeile 146,
sortiere nach diese Spalte "Länge" aufsteigend (eigentlich umgekehrt, aber so sehen wir schneller die Problemfälle)
setze in D2 den Test =FINDEN (A3;A2), erweitere nach unten.
Sieht sch.. nicht besonders gut aus. Ersetze durch =WENNFEHLER(FINDEN(A3;A2);"")
erweitern bis 145. Nicht 146, sondern 145. Der letzte Test wäre 146 zu 147, also geht gegen eine leere Eintrag. Gilt nicht.
Was sehen wir damit?
Wenn wir die gesamte Spalte markieren, zeigt es unten rechts "Summe: 4", also sehen wir oben mit den 4 Einser alle Treffer. Kein Überrschung : nur Einzelbuchstabe.
In Zeile 5 und 6 haben wir einen Artikelteil "D" der sowohl in der Zielspalte C als auch D zugeordnet werden kann. Dito "L", "R"und "V" die in D oder E.
Da diese Fälle immer in 2 Spalten nebeneinander liegen, kann man davon ausgehen, dass es hier um ein Inventur-Fehler handelt. In deine Datei 148833 findet man kein "D" an zweiter Stelle der Artikelbezeichnung (Spalte D) aber wohl an erster (Spalte C). Aber es könnte schon eine unentdeckte Lücke im originale Behandlung sein.
Hier sind 2 Fälle möglich: Fehler. Einfach: korrigieren, oder die Buchstabe D, L, R und V können tatsächlich sowohl an einer als auch an der anderen Stelle vorkommen: dann müsste es geprüft, mit welchem nebenliegende Elemente diese in Kombination vorkommen und diese als "doppelte Eintrag" auflisten: in der Quelldatei findet man "D L11", "D L21", "D L31", "D R11", "D R21", "D R31". Diese 6 Einträge könnten als Wörter in der Liste aufgenommen werden und dazu eine kombinierte Zielspalte "C;D" eingetragen werden. Der Leerzeichen ist der Trenner (nur ein Beispiel. Trifft mit D nicht zu).
Dieselbe Prüfung ist dann mit L, R und V zu machen.
Meine persönliche Analyse:
"D" zu C,
"L" zu F, ausser "L IN" und "L K" in E;F
"R" zu E,
"V" zu E, aber "V R" in E;F !
Wenn damit Fertig, spricht falsche Einträge raus, neue rein:
nach Wortspalte alphabetisch sortieren,
Formel für Länge prüfen,
nach Längenspalte -diesmal- absteigend sortieren (diesmal richtig: wir müssen zuerst die längste Teilbezeichnung rausnehmen)
Nur zum Testzweck, Formel =WENNFEHLER(FINDEN(A2;A3);"") **Achtung: A2,A3 jetzt getauscht, weil umgekehrte Längenreihenfolge**
nach unten erweitern, Summe anschauen. Sollte null sein.
Jetzt haben wir die überschneidungsfreie und wohl sortierte Wortliste. Wir müssen nur noch unsere Suche anpassen: nicht mehr VarDat 1 bis 8 pro Artikelbezeichnung sondern die ganze Liste pro Artikelbezeihnung. Gibt es ein Treffer, wird der Treffer in der gegebenen Zielspalte abgelegt und aus der Artikelbezeichnung rausgenommen.
Bei unseren Sonderfall wird das Suchwort in den 2 Zielspalten gesplittet "L IN" in "E;F" --> "L" in E und "IN" in F.
Die Prüfung ist einfach: nach Trennung der Einzelement wird die Artikelbezeichnung wieder aufgebaut und mit das Original verglichen.
Mit einem Filter auf den Vergleich werden die fehlende Einträge schnell gefunden:
"Accent ON" (C)
"Push Dim" (H), Leerzeichen anstatt Bindestrich
"- mb" (E)
"L IN" (E;F)
"L K" (E;F)
"V R" (E;F)
Hier die Datei mit Wortliste und Code. Artikeldatei ist im Code festgeschrieben. Muss man noch anpassen.
https://www.herber.de/bbs/user/148883.xlsm
(klingt ähnlich wie 148833 :-)
Viel Erfolg damit
VG
Yal
Anzeige
AW: Abgleich von 2 Arrays nach Split der Strings
02.11.2021 13:36:05
2
Hallo Yal,
vielen, vielen Dank für Deine Bemühungen und Deine (nächtliche Zeit). Sehr viel - bewunderungswürdiger Input!
Ich konnte nun etwas Einblick gewinnen.
Den abgebildeten Code habe ich auch zum Laufen gebracht. Ich habe das "thisworkbooks" korrigiert und dann auch aus "W.Range("A99999").End(xlUp). ... " das führende "W" entfernt.
Deine umfassenden Ausführungen in Bezug auf D, L, R, V muss ich sicherheitshalber noch mal durchgehen, scheinen aber absolut korrekt zu sein. Das muss ich mir aber noch einmal ansehen die Tage. Ich bin heute und morgen unterwegs. Ich prüfe auch noch mal die ganzen Bezeichnungen, gehe aber davon aus, dass diese korrekt sind.
Ich sende Die anbei mal die komplette Liste mit 17.893 Datensätzen zu. Das ändert ja an der Wortliste nichts denn meine Arrays beruhen auf dieser kompletten Liste.. Ich hatte die komplette Liste wegen der 300 KB Grenze reduziert gehabt.
In Deiner Datei sind noch andere Codes im Tabellenblatte einhalten. Die, insbesondere das sub temp, muss ich mir erst noch ansehen. Für was ist dieses sub temp bitte?
Ich gehe davon auch aus den v148833 (1).xlsb auf 148833.xlsb ändern zu müssen.
Die komplette Liste https://www.herber.de/bbs/user/148901.xlsb
Allerbeste Grüße Yal
Robert
Anzeige
AW: Abgleich von 2 Arrays nach Split der Strings
02.11.2021 16:54:55
2
Hallo Robert,
vielen Dank für die Würdigung. Es ist so, dass wenn Sudoku langweilig wird, man sich andere Herausvorderung sucht. Auch ganz gut ist zum Beispiel Advent Of Code ( https://adventofcode.com/2020/day/1 )
Die Sub Temp spielt keine Rolle. Es ersetzt lediglich die eventuelle Formel durch Wert, war in dem Fall nicht notwendig. Gläten war angesagt.
Was noch nicht angesprochen wurde, ist, dass die Zuordnung eine Sachverhaltzuordnung entsprechen sollte. Warum soll einen "R" mal in Spalte E, mal in Spalte F? Was wäre der Überschrift dieser Spalte? Vielleicht sind dementsprechend nicht 8 Spalten sondern mehr (oder gar weniger) und dafür ein anweichenden Suchmuster notwendig.
Aber wie auch immer. mit der Lösung und dem Vorgehensweise hast Du jetzt eine gute Grundlage, um das Gesamt erfolgreich zu Ende zu bringen. Ob ich die Zeit habe, um die gesamte Liste anzuschauen, ist unklar.
VG
Yal
Anzeige
AW: Abgleich von 2 Arrays nach Split der Strings
04.11.2021 17:14:53
2
Hallo Yal,
" ... wenn Sudoku langweilig wird", ist ein starker Satz. Den kann ich mir noch nicht leisten. Leider :-)
Ich habe die Liste nur mal zur Info beigefügt. Sie ändert an Deiner tollen Wortliste ja nichts.
Ich habe nun Deine ganzen Codes durch die fast 18.000 Datensätze laufen lassen. Es passt alles. Nur "Telescope D" erfolgte die Zuordnung "D" auf 1. Spalte und das "Telescope" fällt komplett raus.
"Telescope A" geht auf "Telescope" und "A" - Perfekt
"Telescope B" geht auf "Telescope" und "B" - Perfekt
"Telescope C" geht auf "Telescope" und "C" - Perfekt
"Telescope E" geht auf "Telescope" und "E" - Perfekt
Ich habe nun "Telescope D" mit "C;D" in die Wortliste entsprechend der Länge an die richtige Stelle einfügen und es scheint zu KLAPPEN!! Genial von Dir!!!!
Ich prüfe nun erst mal die Abhängigkeiten von L, R, V und D nach dem Motto,
wenn in Spalte 1 ein Artikelname D - ist ein D in Spalte 2 möglich?
wenn in Spalte 2 ein Bestandteile L - ist ein L in Spalte 3 überhaupt möglich?
wenn in Spalte 2 ein Bestandteile R - ist ein R in Spalte 3 überhaupt möglich?
wenn in Spalte 2 ein Bestandteile V - ist ein V in Spalte 3 überhaupt möglich?
Wenn dem nicht so sein sollte, wäre uns ja enorm geholfen, oder? Im Moment glaube ich, dass wir Glück haben.
Sprich, ich prüfe auch die von Dir angesprochene "Sachverhaltszuordnung'.
-mb prüfe ich gesondert, fällt u.U. ganz raus.
Sag mir bitte Bescheid, wenn es Dir zu viel wird.
Vielen Dank!
Beste Grüße
Robert

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige