stimmt, steht da noch aufgrund copy & pace...
Ja das ist eine Idee, die wir bereits aufgenommen haben. Mir geht es hierbei mehr darum:
Beispielhaft:Das Makro sucht die Lieferanten im Bereich Spalte E bis Spalte H gesucht
So jetzt steht in Spate E > Huber GmbH in Spalte F > Schreibwaren in Spalte G > Füller und in Spalte H > Patronen
Ausgabe in Spalte I > Huber GmbH >>> passt genauso!
Aber jetzt gibt es den Fall, dass in Spalte E > Huber GmbH in Spalte F > Huber in ….
Ausgabe in Spalte I > Achtung >>>> passt nicht, da der Lieferant ja vorkommt, diesen aber wahrscheinlich nicht richtig zuordnen kann.
Daher die Anfrage ob man da das Makro ändern kann, bzw. erweitern kann, damit der eindeutige Name kommt.
Aber grundsätzlich sehr guter Einwand die Namen aufzugreifen und in die Liste hinzuzufügen, mit diesem Gedanken haben wir bereits auch gespielt.
In den Originaldaten ist das aber eher Schwierig... Aufgrund der hohen Anzahl an Lieferanten
12.03.2020, 11:27 (Dieser Beitrag wurde zuletzt bearbeitet: 12.03.2020, 11:36 von atilla.
Bearbeitungsgrund: Code gekürzt
)
Hallo,
da Ihr nach Komma aufteilt, wird der Code einfacher.
Das Aufteilen mache ich auch im Code, so dass Ihr die Spalten E:I nicht braucht.
Die Spalten C:D reichen aus, um das von Dir gezeigte Ergebnis zu erreichen.
Unten der Code erzielt mit diesen Daten in "Tabelle 1 Lieferantenliste"
Arbeitsblatt mit dem Namen 'Tabelle 1 Lieferantenliste'
C
5
Lieferantenliste
6
Huber AG
7
Müller GmbH
8
Maier GmbH & Co. KG
9
Mustermann KG
10
Ich AG
Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016
dieses Ergebnis in Spalte K in Tabelle "Tabelle 2 Zieltabelle":
Arbeitsblatt mit dem Namen 'Tabelle 2 Zieltabelle'
C
D
E
F
G
H
I
J
K
3
Lieferanten
Bestellung
Lieferanten(kopiert aus Spalte C)
Aufteilung 1
Aufteilung 2
Aufteilung 3
Aufteilung 4
Ziel
4
Huber AG
Schreibwaren
Wenn der Wert im Bereich Spalte E bis Spalte I mit einem Wert aus der Lieferantenlist übereinstimmt, dann gebe mir den Wert aus der Lieferantenliste (ohne auf die Rechtschreibfehler, oder Groß und Kleinschreibung zu achten), dann gebe mir den Wert In Spalte J Zeile 4 (hier also Huber AG) E aus
Huber AG
5
Huber AG
Huber AG, Schreibwaren, Füller
Hier Huber AG
Huber AG
6
Müller GmbH
mülller, Gebäck, Breze, Semmel
Hier Müller GmbH
Müller GmbH
7
DPMG
DPMG, Tische
Hier ACHTUNG
ACHTUNG
8
Huber AG
huber, Schreibwaren, Bleistift
Hier Huber AG
Huber AG
9
CPD LUL
Müller GmbH, Gebäck
Mülller GmbH
Müller GmbH
10
Mustermann KG
Tassen
Hier Mustermann KG
Mustermann KG
11
Müller GmbH
Gebäck
Hier Müller GmbH
Müller GmbH
12
Ich AG
Ich AG, Musik, DVD,
Hier Ich AG
Ich AG
13
EFRR
EFRR, Musikplatte Ich
Hier ACHTUNG
ACHTUNG
14
Maier GmbH & Co. KG
Bilder
Hier Maier GmbH & Co. KG
Maier GmbH & Co. KG
15
CPD LUL
huber, Schreibwaren
Ziel Huber
Huber AG
16
Huber ag
Schreibwaren
Hier Huber AG
Huber AG
17
Müller GmbH
Gebäck
Hier Müller GmbH
Müller GmbH
18
Mustermann KG
Mustermann, Teller
Hier Mustermann KG
Mustermann KG
19
Müller GMBH
Müller GmbH, Gebäck
Hier Müller GMBH
Müller GmbH
20
Maier GmbH & Co. KG
Bilder
Hier Maier GmbH & Co. KG
Maier GmbH & Co. KG
21
Mustermann KG
Besteck
Hier Mustermann KG
Mustermann KG
22
Maier GMBH & CO KG
Maier, Bilderrahmen
Hier Maier GMBH & CO KG
Maier GmbH & Co. KG
23
Ich AG
Musik
Hier Ich AG
Ich AG
Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016
Du siehst, dass ich die gleichen Ergebnisse habe, wie Du in Spalte J.
Noch mal, die Aufteilung in Spalten E-I brauche ich nicht.
Hier der Code:
Code:
Sub prüfen()
Dim i As Long, j As Long, n As Long
Dim lngSuche As Long, lngL
Dim vantZ
Dim suchFeld
Dim Lieferanten
Dim strgWarnung As String
Dim arrSuchText
strgWarnung = "ACHTUNG"
'Lieferantentabelle
With Sheets("Tabelle 1 Lieferantenliste")
lngL = .Cells(.Rows.Count, 3).End(xlUp).Row
Lieferanten = .Range("C6:C" & lngL)
End With
'Suchtabelle
With Sheets("Tabelle 2 Zieltabelle")
lngSuche = .Cells(.Rows.Count, 3).End(xlUp).Row
suchFeld = .Range("C4:E" & lngSuche)
For i = 1 To lngSuche - 3
arrSuchText = Split(suchFeld(i, 1) & "," & suchFeld(i, 2), ",")
For n = LBound(arrSuchText) To UBound(arrSuchText)
vantZ = Application.Match("*" & arrSuchText(n) & "*", Lieferanten, 0)
If IsNumeric(vantZ) Then
suchFeld(i, 3) = Lieferanten(vantZ, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
Else
suchFeld(i, 3) = strgWarnung
End If
Next n
Next i
.Range("K4:K" & lngSuche).ClearContents 'Bereich zum schreiben löschen
.Range("K4:K" & lngSuche) = (Application.Index(suchFeld, 0, 3)) 'Ergebnisse schreiben
End With
End Sub
bitte entschuldige, dass ich mich erst so spät wieder melde, aber deine kleine Änderung hat uns neue Erkenntnisse erbracht, welche wir erstmal analysiert haben.
Daher kann ich mich nur umso mehr bei dir bedanken!!!!
Du hast quasi nicht aufgegeben mir mit meinem Problem zu helfen und für mich ist es eine wahre Meisterleistung aus meiner kryptischen Problemstellung diese Lösung zu bekommen. Ich ziehe meinen nicht vorhandenen Hut!!!
ich habe folgendes Problem:
Durch eure starke Mithilfe konnte ich in meiner Buchhaltungsdatei bereits sehr viele Lieferanten zuordnen und dadurch eine gute Auswertung fahren. Leider ist uns aber vereinzelt aufgefallen, dass das Makro eine falsche Zuordnung des Lieferanten vornimmt. Auffallend ist dabei, dass das Makro dabei feste Begriffe aufnimmt, mit der Lieferantenliste vergleicht und diese dann, aufgrund der Ähnlichkeit, zuordnet.
Zusätzlich kommt es auch vor, dass wenn ein Lieferant in der Lieferantenliste steht und dieser auch in der Spalte Lieferanten vorkommt, das Ergebnis des Makros nicht richtig ist, da es einen Begriff aus der Bestellungsspalte (vermutlich) aufgreift und zu einem Lieferanten zuordnet (Siehe BSP Tabelle)
Zum besseren Verständnis habe ich euch eine BSP Tabelle angefertigt. Das Makro habe ich dabei nicht auf die Datei angewendet (der Versuch die Fehler darzustellen würde zu viel Zeit in Anspruch nehmen). Daher habe ich eine Ergebnisspalte, die euch die Ergebnisse exemplarisch zeigen soll, hinzugefügt.
Zur Erinnerung: Kommt ein Lieferant nicht in der Lieferantenliste vor, soll das Makro „Achtung“ als Ergebnis auswerfen.
Kommentar zur Beispieldatei: Eine Lösung wäre eine Mitarbeiterliste, jedoch kann nicht davon ausgegangen werden, diese zu bekommen, außerdem gibt es dann immer noch Fälle die keinen Namen, etc. vorweisen.
Kommentar zur Originaldatei: Auffallend ist, dass das Makro meistens dann ein falsches Ergebnis zeigt, wenn ein Komma zu viel gemacht worden ist, oder der Satz mit einem Kommazeichen endet.
Vermutung: Das Makro geht nach bestimmten Suchkriterien vor, müssten diese evtl. geändert werden bzw. erweitert werden?
Verwendetes Makro:
Code:
Sub prüfen()
Dim i As Long, j As Long, n As Long
Dim lngSuche As Long, lngL
Dim vantZ
Dim suchFeld
Dim Lieferanten
Dim strgWarnung As String
Dim arrSuchText
strgWarnung = "ACHTUNG"
'Lieferantentabelle
With Sheets("Lieferantenliste")
lngL = .Cells(.Rows.Count, 3).End(xlUp).Row
Lieferanten = .Range("C26:C" & lngL)
End With
'Suchtabelle
With Sheets("Ergebnis")
lngSuche = .Cells(.Rows.Count, 3).End(xlUp).Row
suchFeld = .Range("C4:D" & lngSuche)
For i = 1 To lngSuche - 3
arrSuchText = Split(suchFeld(i, 1) & "," & suchFeld(i, 2), ",")
For n = LBound(arrSuchText) To UBound(arrSuchText)
vantZ = Application.Match("*" & arrSuchText(n) & "*", Lieferanten, 0)
If IsNumeric(vantZ) Then
suchFeld(i, 2) = Lieferanten(vantZ, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
Else
suchFeld(i, 2) = strgWarnung
End If
Next n
Next i
.Range("I2:I" & lngSuche).ClearContents 'Bereich zum schreiben löschen
.Range("I2:I" & lngSuche) = (Application.Index(suchFeld, 0, 2)) 'Ergebnisse schreiben
End With
End Sub
Unten der korrigierte Code für die zuletzt eingestellte Beispielmappe:
Code:
Sub prüfen()
Dim i As Long, j As Long, n As Long
Dim lngSuche As Long, lngL
Dim vantZ
Dim suchFeld
Dim Lieferanten
Dim strgWarnung As String
Dim arrSuchText
strgWarnung = "ACHTUNG"
'Lieferantentabelle
With Sheets("Lieferantenliste")
lngL = .Cells(.Rows.Count, 3).End(xlUp).Row
Lieferanten = .Range("C2:C" & lngL).Value
End With
'Suchtabelle
With Sheets("Ergebnis")
lngSuche = .Cells(.Rows.Count, 3).End(xlUp).Row
suchFeld = .Range("C4:D" & lngSuche)
For i = 1 To lngSuche - 3
arrSuchText = Split(suchFeld(i, 1) & "," & suchFeld(i, 2), ",")
For n = LBound(arrSuchText) To UBound(arrSuchText)
vantZ = Application.Match("*" & arrSuchText(n) & "*", Lieferanten, 0)
If IsNumeric(vantZ) Then
suchFeld(i, 2) = Lieferanten(vantZ, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
Else
suchFeld(i, 2) = strgWarnung
End If
Next n
Next i
.Range("I4:I" & lngSuche).ClearContents 'Bereich zum schreiben löschen
.Range("I4:I" & lngSuche) = (Application.Index(suchFeld, 0, 2)) 'Ergebnisse schreiben
End With
End Sub
Hallo,
und hier die Ergebnisse nach Makro Ausführung:
Arbeitsblatt mit dem Namen 'Ergebnis'
C
D
E
F
G
H
I
3
Lieferanten
Bestellung
Ergebnis Makro
Bemerkung
4
Huber AG
huber, Schreibwaren, Bleistift
Huber AG
Huber AG
5
CPD LUL
Müller gmbh, Gebäck
Müller GmbH
Müller GmbH
6
Mustermann KG
Tassen
Mustermann KG
Mustermann KG
7
Max Schäfer
Gebäck, Wasser, Kaffee
Wasserverband e.V.
da der Lieferant nicht in der Lieferantenliste auftaucht, sollte hier ein Achtung stehen
ACHTUNG
8
Müller GmbH
Gebäck
Müller GmbH
Müller GmbH
9
CPD LUL
Cola, Kaffee, Wasser
Wasserverband e.V.
da der Lieferant nicht in der Lieferantenliste auftaucht, sollte hier ein Achtung stehen
ACHTUNG
10
Ich AG
Musik, DVD, etc.
Ich AG
Ich AG
11
EFRR
EFRR, Musikplatte
Achtung
richtig
ACHTUNG
12
CPD LUL
Schreibwaren
Achtung
richtig
ACHTUNG
13
Wasserverband e.V.
Prüfung Wasserstand
Wasserverband e.V.
Wasserverband e.V.
14
Stefanie Huber
Fahrtkostenrückerstattung
Huber AG
da der Lieferant nicht in der Lieferantenliste auftaucht, sollte hier ein Achtung stehen
ACHTUNG
15
Backstube Breze
Müller-Brot, Semmeln, Brezen
Müller GmbH
hier sollt das Makro eigentlich den Lieferant Backstube Breze wiedergeben
Backstube Breze
16
Müller GmbH
Semmeln, Kaffee, Wasser
Wasserverband e.V.
hier sollt das Makro eigentlich den Lieferant Müller Gmbh wiedergeben
09.04.2020, 10:41 (Dieser Beitrag wurde zuletzt bearbeitet: 09.04.2020, 10:42 von ABC_15.)
Hallo liebe Community,
ich glaube ich schärfe noch einmal ein bisschen mein Problem:
Die Situation: Durch das untenstehende Makro können wir in unserer Buchhaltungsdatei bereits ein Großteil der Lieferanten den Positionen zuordnen. Es gibt eine selbsterstelle Lieferantenliste, die das Makro zur Zuordnung nutzt. Die Konten, welche keinen Lieferanten darstellen und auch nicht in der Lieferantenliste auftauchen haben den Lieferanten meistens in einer anderen Spaltenbezeichnung (Bestellung) stehen. Und auch das, kann das Makro meistens verarbeiten und die Lieferanten zuordnen. Jedoch ist uns bei genauerem Hinsehen folgendes Problem aufgefallen:
Das Problem:
Hier ein BSP aus der Originaldatei mit dem Lieferanten 1&1, da gerade beim Lieferanten 1&1 vermehrt Fehler auftauchen.
[url=
Arbeitsblatt mit dem Namen 'Tabelle1'
C
D
E
F
4
Nr.
Lieferant
Bestellung
Ergebnis Makro
5
1
Betriebs-/Gesch.aus.
Stuhl schwarz, Stoffbezug Andrea,
1&1 Internet SE
6
2
Betriebs-/Gesch.aus.
Stuhl schwarz, Stoffbezug Andrea
Achtung
Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016
][/url][color=#000000][size=x-small][font=Calibri]Arbeitsblatt mit dem Namen 'Tabelle1'
Der Originalbuchungssatz ist die Nr. 1 in der Bestellung fällt auf, das nach dem Namen des Stoffbezugs ein Komma geschrieben ist. Das Ergebnis des Makros zeigt dann aber 1&1 Internet SE
Ich habe zur Überprüfung das Komma nach dem Namen Andrea entfernt und das Makro nochmals darüber laufen lassen. Das Ergebnis in Nr. 2 ist Richtigerweise Achtung, da weder in der Spalte Lieferant noch in der Spalte Bestellung ein Lieferantenname auftaucht, welcher in der meiner Lieferanteliste steht
Ein weiteres Beispiel
[url=
Arbeitsblatt mit dem Namen 'Tabelle1'
C
D
E
F
8
Nr.
Lieferant
Bestellung
Ergebnis Makro
9
1
Max Mustermann
Mustermann M., Auslage Wasser, Cola, Essen
Achtung
10
2
Max Mustermann
Mustermann, Auslage, Getränke, Wasser
Wasserverband e.V.
11
3
Max Mustermann
Mustermann M., Wasser, Getränke
Wasserverband e.V.
Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016
][/url][color=#000000][size=x-small][font=Calibri]Arbeitsblatt mit dem Namen 'Tabelle1'
Nr. 1-3 sind alles Originalbuchungssätze (natürlich mit anderem Namen), folgende Beobachtung können festgestellt werden: in Nr. 1 ist in der Bestellung nach dem Wort Auslage kein Komma, sondern nur ein Leerzeichen, das Ergebnis des Makros ist richtigerweise Achtung.
In den Buchungssätzen Nr. 2 und 3 ist jeweils nach dem Wort Getränke bzw. Mustermann M. ein Komma und ein Leerzeichen. Es folgt das Wort Wasser, etc. In beiden fällen ordnet das Makro Wasserverband e.V. als Lieferant zu. Der Wasserverband e.V. ist zwar in der Lieferantenliste geführt, hat jedoch nichts mit dieser Buchung zu tun. Das korrekte Ergebnis wäre hier Achtung.
Ein letztes Beispiel bzw. Problem:
[url=
Arbeitsblatt mit dem Namen 'Tabelle1'
C
D
E
F
13
Nr.
Lieferant
Bestellung
Ergebnis Makro
14
1
CPD LUL
Office, 3xMauspads
1&1 Internet SE
15
2
CPD LUL
1&1 Internet SE
Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016
][/url][color=#000000][size=x-small][font=Calibri]Arbeitsblatt mit dem Namen 'Tabelle1'
Bei den Buchungssätzen handelt es sich wieder um Originaldateien. CpD LuL ist eine interne Kontobezeichnung und kein Lieferant. In Buchungssatz Nr. 1 steht in der Spalte Bestellung ist ein Bestellvorgang beschrieben, das Ergebnis des Makros zeigt aber 1&1 Internet SE. Richtigerweise hätte es „Achtung“ oder, was ich eher verstanden hätte, einen Lieferanten mit Office im Namen zuordnen müssen.
In Buchungssatz Nr. 2 ist in der Bestellungsspalte nichts abgebildet, das Makro wirft aber trotzdem 1&1 Internet SE als Ergebnis aus. Richtigerweise wäre Achtung
Ihr seht also, dass das Makro viel mit dem Komma verbindet und wahrscheinlich Ähnlichkeiten sucht und diese dann zuordnet. Aber gerade bei den Problemen des Lieferanten 1&1 Internet SE verstehe ich die Zuordnung des Makros nicht. Vielleicht habe ihr eine Idee?
Ich habe auch nochmals eine Beispieltabelle inkl. Der obigen Fälle erstellt.
Hier nochmal das Makro
Code:
Sub prüfen()
Dim i As Long, j As Long, n As Long
Dim lngSuche As Long, lngL
Dim vantZ
Dim suchFeld
Dim Lieferanten
Dim strgWarnung As String
Dim arrSuchText
strgWarnung = "ACHTUNG"
'Lieferantentabelle
With Sheets("Lieferantenliste")
lngL = .Cells(.Rows.Count, 3).End(xlUp).Row
Lieferanten = .Range("C2:C" & lngL).Value
End With
'Suchtabelle
With Sheets("Ergebnis")
lngSuche = .Cells(.Rows.Count, 3).End(xlUp).Row
suchFeld = .Range("C4:D" & lngSuche)
For i = 1 To lngSuche - 3
arrSuchText = Split(suchFeld(i, 1) & "," & suchFeld(i, 2), ",")
For n = LBound(arrSuchText) To UBound(arrSuchText)
vantZ = Application.Match("*" & arrSuchText(n) & "*", Lieferanten, 0)
If IsNumeric(vantZ) Then
suchFeld(i, 2) = Lieferanten(vantZ, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
Else
suchFeld(i, 2) = strgWarnung
End If
Next n
Next i
.Range("I4:I" & lngSuche).ClearContents 'Bereich zum schreiben löschen
.Range("I4:I" & lngSuche) = (Application.Index(suchFeld, 0, 2)) 'Ergebnisse schreiben
End With
End Sub
bezogen auf die Beispieldatei, warum soll in Zeile 22 bei Schmidt GmbH nichts erscheinen. Sollte da nicht Achtung erscheinen, da Schmidt GmbH in Lieferanten nicht existiert.
Warum soll in Zeile 24 Achtung erscheinen? Mustermann wird in Lieferanten gefunden. Das kann mit dem Makro nicht abgefangen werden.
Die anderen Dinge die aufgeführt hast sollten mit einer kleinen Ergänzung jetzt richtig laufen:
Code:
Sub prüfen()
Dim i As Long, j As Long, n As Long
Dim lngSuche As Long, lngL
Dim vantZ
Dim suchFeld
Dim Lieferanten
Dim strgWarnung As String
Dim arrSuchText
strgWarnung = "ACHTUNG"
'Lieferantentabelle
With Sheets("Lieferantenliste")
lngL = .Cells(.Rows.Count, 3).End(xlUp).Row
Lieferanten = .Range("C3:C" & lngL).Value
End With
'Suchtabelle
With Sheets("Ergebnis")
lngSuche = .Cells(.Rows.Count, 3).End(xlUp).Row
suchFeld = .Range("C4:D" & lngSuche)
For i = 1 To lngSuche - 3
arrSuchText = Split(suchFeld(i, 1) & "," & suchFeld(i, 2), ",")
For n = LBound(arrSuchText) To UBound(arrSuchText)
If Len(arrSuchText(n)) Then
vantZ = Application.Match("*" & arrSuchText(n) & "*", Lieferanten, 0)
If IsNumeric(vantZ) Then
suchFeld(i, 2) = Lieferanten(vantZ, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
Else
suchFeld(i, 2) = strgWarnung
End If
End If
Next n
Next i
.Range("I4:I" & lngSuche).ClearContents 'Bereich zum schreiben löschen
.Range("I4:I" & lngSuche) = (Application.Index(suchFeld, 0, 2)) 'Ergebnisse schreiben
End With
End Sub
