habe die auf die Originaldatei zugeschnittene Makro jetzt ein paar mal kontrolliert. Leider finde ich den Fehler nicht.
Im Anhang ist eine Beispieldatei, welche exakt so aussieht wie die Originaldatei. Die Gelb-markierten Felder sind denke ich die relevanten.
Ziel: In Spalte O sollen die Ergebnisse aus dem Makro erscheinen.
Ansonsten ist Spalte G identisch mit Spalte J (nur anderer Name)
In Spalte G (und J) befinden sich jeweils die Lieferanten
In Spalte H die Bezeichnung des Einkaufs (und meistens der Lieferant > zu 99%)
Spalte I ist eine Nummer für den Buchhalter (unrelevant)
In Spalte J sind nochmals die Lieferanten In Spalte K habe ich die Lieferanten-Namen per Aufteilung der Spalte H > lässt sich denke ich sehr gut mit deinem Makro verbinden?!
In den Spalten L, M und N ist wie in Spalte K die Aufteilung der Spalte H erfolgt
In den Spalten P bis AQ sind weitere Daten (allerdings, so denke ich, nicht relevant für deine Makro)
Ich brauche nur zu wissen wo die Tatsächlichen Lieferanten sin und welche Geprüft werden müssen(welche Spalte)
Ich habe das jetzt mal versucht herauszulesen und den Code angepasst.
Teste es. Wenn es nicht passt, bitte nur in Tabelle "Tabelle 1 "Lieferantenliste" den Bereich angeben, in der die zu übernehmenden Lieferanten stehen.
In der Beispieldatei ist es für mich in der "Lieferantenliste" der Bereich G4:G10 bzw. bis zur letzten gefüllten Zeile
Geprüft wird in der Tabelle "Daten" der Bereich "G2:G12" bzw. bis zur letzten gefüllten Zeile
Die Ergebnisse werden in "Daten" ab O2 geschrieben.
So solltest Du es für mich auch zeigen.
Du solltest auch den von Dir zuletzt genutzten Code einstellen, egal ob er funktioniert oder nicht.
So, jetzt teste erst einmal ob das passt.
Code:
Sub prüfen()
Dim i As Long, j As Long, n As Long
Dim lngSuche As Long, lngL
Dim suchFeld
Dim Lieferanten
Dim strgWarnung As String
strgWarnung = "ACHTUNG"
'Lieferantentabelle
With Sheets("Tabelle 1 Lieferantenliste")
lngL = .Cells(.Rows.Count, 7).End(xlUp).Row
Lieferanten = .Range("G4:G" & lngL)
End With
'Suchtabelle
With Sheets("Datentabelle")
lngSuche = .Cells(.Rows.Count, 7).End(xlUp).Row
suchFeld = .Range("G2:O" & lngSuche)
For i = 1 To lngSuche - 1
For j = 1 To lngL - 3
If InStr(1, UCase(Replace(Replace(suchFeld(i, 1), " ", ""), ".", "")), UCase(Replace(Replace(Lieferanten(j, 1), " ", ""), ".", ""))) Then
suchFeld(i, 9) = Lieferanten(j, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
ElseIf InStr(1, UCase(Replace(Replace(Lieferanten(j, 1), " ", ""), ".", "")), UCase(Replace(Replace(suchFeld(i, 1), " ", ""), ".", ""))) Then
suchFeld(i, 9) = Lieferanten(j, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
Else
suchFeld(i, 9) = strgWarnung
End If
Next j
Next i
.Range("O2:O" & lngSuche).Select
.Range("O2:O" & lngSuche).ClearContents 'Bereich zum schreiben löschen
.Range("O2:O" & lngSuche) = (Application.Index(suchFeld, 0, 9)) 'Ergebnisse schreiben
End With
End Sub
In der Originaldatei stehen die Lieferanten in der Tabelle `Tabelle 1 Lieferantenlist´ in G4:G511
Geprüft wird in der Tabelle `Makro Lösung´ in G2:bis zur letzten befüllten Zeile in G / Noch besser wäre: Geprüft in K2:bis zur letzten befüllten Zeile in K
Die Ergebnisse sollen ab Spalte O Zeile 2 geschrieben werden
Das ist dein Code, leicht angepasst (Spalte K statt G und der Tabellenname `Makro Lösung´ statt `Datentabelle´):
Insgesamt hast du ja eigentlich alles richtig eingeschätzt...
Code:
Sub prüfen()
Dim i As Long, j As Long, n As Long
Dim lngSuche As Long, lngL
Dim suchFeld
Dim Lieferanten
Dim strgWarnung As String
strgWarnung = "ACHTUNG"
'Lieferantentabelle
With Sheets("Tabelle 1 Lieferantenliste")
lngL = .Cells(.Rows.Count, 7).End(xlUp).Row
Lieferanten = .Range("G4:G" & lngL)
End With
'Suchtabelle
With Sheets("Makro Lösung")
lngSuche = .Cells(.Rows.Count, 11).End(xlUp).Row
suchFeld = .Range("K2:O" & lngSuche)
For i = 1 To lngSuche - 1
For j = 1 To lngL - 3
If InStr(1, UCase(Replace(Replace(suchFeld(i, 1), " ", ""), ".", "")), UCase(Replace(Replace(Lieferanten(j, 1), " ", ""), ".", ""))) Then
suchFeld(i, 9) = Lieferanten(j, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
ElseIf InStr(1, UCase(Replace(Replace(Lieferanten(j, 1), " ", ""), ".", "")), UCase(Replace(Replace(suchFeld(i, 1), " ", ""), ".", ""))) Then
suchFeld(i, 9) = Lieferanten(j, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
Else
suchFeld(i, 9) = strgWarnung
End If
Next j
Next i
.Range("O2:O" & lngSuche).Select
.Range("O2:O" & lngSuche).ClearContents 'Bereich zum schreiben löschen
.Range("O2:O" & lngSuche) = (Application.Index(suchFeld, 0, 9)) 'Ergebnisse schreiben
End With
End Sub
Sub prüfen()
Dim i As Long, j As Long, n As Long
Dim lngSuche As Long, lngL
Dim suchFeld
Dim Lieferanten
Dim strgWarnung As String
strgWarnung = "ACHTUNG"
'Lieferantentabelle
With Sheets("Tabelle 1 Lieferantenliste")
lngL = .Cells(.Rows.Count, 7).End(xlUp).Row
Lieferanten = .Range("G4:G" & lngL)
End With
'Suchtabelle
With Sheets("Makro Lösung")
lngSuche = .Cells(.Rows.Count, 11).End(xlUp).Row
suchFeld = .Range("K2:O" & lngSuche)
For i = 1 To lngSuche - 1
For j = 1 To lngL - 3
If InStr(1, UCase(Replace(Replace(suchFeld(i, 1), " ", ""), ".", "")), UCase(Replace(Replace(Lieferanten(j, 1), " ", ""), ".", ""))) Then
suchFeld(i, 5) = Lieferanten(j, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
ElseIf InStr(1, UCase(Replace(Replace(Lieferanten(j, 1), " ", ""), ".", "")), UCase(Replace(Replace(suchFeld(i, 1), " ", ""), ".", ""))) Then
suchFeld(i, 5) = Lieferanten(j, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
Else
suchFeld(i, 5) = strgWarnung
End If
Next j
Next i
.Range("O2:O" & lngSuche).Select
.Range("O2:O" & lngSuche).ClearContents 'Bereich zum schreiben löschen
.Range("O2:O" & lngSuche) = (Application.Index(suchFeld, 0, 5)) 'Ergebnisse schreiben
End With
End Sub
So sieht es in der zuletzt eingestellten Beispielmappe in "Tabelle 1 Lieferantenliste" aus:
Arbeitsblatt mit dem Namen 'Tabelle 1 Lieferantenliste'
also ich zweifele gerade an mir selbst... ich bekomme es nicht hin. Es kommt immer wieder die Fehlermeldung Laufzeitfehler 9 "Index außerhalb des gültigen Bereichs"
Dabei befolge ich deine Ratschläge und (eigentlich) weiß ich auch was welche Spalten, Zeilen relevant, bzw. in das Makro eingetragen werden müssen...
Aber die Beispieldatei ist perfekt! Das ist 1:1 was wir suchen!
Ich möchte dich wirklich nicht nerven! Vielleicht hast du noch eine andere Idee, wo mein Fehler liegt? :22:
Vielleicht beachte ich irgendwas bei der Umsetzung nicht?
ich kann nicht sagen was da falsch läuft.
Ich habe Dir mehrmals geschrieben, was entscheidend ist.
Nochmal, die Tabellennamen müssen exakt so heißen wie im Code. Kopier sie aus den Blattregistern in den Code. Im Code sind sie mit Anführungszeichen umschlossen.
Dann sind die Bereiche wichtig. Sie müssen zwingend so sein wie in meinem Code.
Wenn im Code G4:G & lngL steht, solltest Du das nicht ändern.
Denn wenn Du das änderst, dann muss noch an anderer Stelle etwas geändert werden.
Du kannst jetzt die verschiedenen Codes mal gegenüberstellen, dann erkennst Du vielleicht wo etwas zu ändern ist.
Du siehst ja, dass es bei mir ohne Fehlermeldung funktioniert. Wenn bei Dir eine Fehlermeldung auftaucht, dann ist die Beispielmappe nicht am Original orientiert, obwohl ich Dich mehrmals dazu aufgefordert habe.
weil du mir so extrem weitergeholfen hast, wende ich mich hier gleich nochmal an dich.
Und keine Angst. Diesmal keine Frage warum das Makro nicht geht :19:
Viel eher geht es um folgendes:
Wir haben dein Makro nun erfolgreich angewendet. Und es wirft an den richtigen Stellen das Achtung raus. Da dies aber ziemlich oft vorkam, haben wir uns folgendes überlegt: (siehe auch Ziel-Datei)
bisher:
Spalte C > Lieferanten
Spalte D > Bestellung plus Lieferant Spalte E bis I > Aufteilung der Spalte D
Spalte J > Lösung durch dein Makro: Suche den Bereich nach den Lieferanten aus der Tabelle mit den Lieferantennamen ab und bei Übereinstimmung schreibe den Lieferant in Spalte J
Neuer Ausgangspunkt
Spalte C > Lieferanten
Spalte D > Bestellung plus Lieferant
Spalte E > Kopie der Spalte C
Spalte F bis hier I > Aufspaltung der Spalte D
Ziel: Spalte J > Suche den Bereich nach den Lieferanten aus der Tabelle mit den Lieferantenamen ab und bei Übereinstimmung schreibe den Lieferant in Spalte J
Durch die Kopie der Spalte C sollte eig. sichergestellt sein, dass wenn ein Lieferant in Spalte C oder D vorkommt und mit der Lieferantenliste übereinstimmt, dieser auch ausgeworfen wird (durch das Makro). Haben wir mit deinem Makro auch bereits getestet und die Feststellung gemacht, dass wenn ein Lieferant doppelt vorkommt (z.B. Spalte E > Huber GmbH, Spalte F > Huber, Spalte G >Schreibwaren) dann ein Achtung kommt, da er wahrscheinlich die Namen nicht zuordnen kann
Zusätzlich kann es sein, dass zwei unterschiedliche Lieferanten vorkommen, da z.B. Hr Huber gekauft hat, dass sieht dann so aus:
Spalte E > Müller GmbH, Spalte F > Huber, Spalte G > Schreibwaren
Wäre super, wenn du da noch was an deinem Makro so verändern kannst, dass wir zumindest eine Lösung wie in der Beispieldatei bekommen.
Vielen Dank schonmal vorab
VG
Dein persönlicher Problemfall ABC_15 ;)
Anbei noch dein Makro zur Erinnerung/evtl. Benutzung:
Info: Makro wurde nicht in der Zieldatei verwendet!!!
Code:
Sub prüfen()
Dim i As Long, j As Long, n As Long
Dim lngSuche As Long, lngL
Dim suchFeld
Dim Lieferanten
Dim strgWarnung As String
strgWarnung = "ACHTUNG"
'Lieferantentabelle
With Sheets("Lieferantenliste")
lngL = .Cells(.Rows.Count, 7).End(xlUp).Row
Lieferanten = .Range("G4:G" & lngL)
End With
'Suchtabelle
With Sheets("Daten 2017")
lngSuche = .Cells(.Rows.Count, 9).End(xlUp).Row
suchFeld = .Range("I2:M" & lngSuche)
For i = 1 To lngSuche - 1
For j = 1 To lngL - 3
If InStr(1, UCase(Replace(Replace(suchFeld(i, 1), " ", ""), ".", "")), UCase(Replace(Replace(Lieferanten(j, 1), " ", ""), ".", ""))) Then
suchFeld(i, 5) = Lieferanten(j, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
ElseIf InStr(1, UCase(Replace(Replace(Lieferanten(j, 1), " ", ""), ".", "")), UCase(Replace(Replace(suchFeld(i, 1), " ", ""), ".", ""))) Then
suchFeld(i, 5) = Lieferanten(j, 1) 'Bei Fund wird die Bezeichnung aus Lieferantenliste zurückgegeben
Exit For
Else
suchFeld(i, 5) = strgWarnung
End If
Next j
Next i
.Range("M2:M" & lngSuche).Select
.Range("M2:M" & lngSuche).ClearContents 'Bereich zum schreiben löschen
.Range("M2:M" & lngSuche) = (Application.Index(suchFeld, 0, 5)) 'Ergebnisse schreiben
End With
End Sub
Das würde einen größeren Programmieraufwand nach sich ziehen, wurde ja schon angesprochen.
Wenn Du das zumindest rudimentär einbauen willst kannst Du Deine Lieferantenliste um fehlerbehaftete Einträge ergänzen und dann die Begriffe im gesamten Bereich suchen …
z.B.
Arbeitsblatt mit dem Namen 'Tabelle 1 Lieferantenliste'
C
D
E
F
G
5
Lieferantenliste
6
Huber AG
Hubr AG
Hubber AG
7
Müller GmbH
Mueller GmbH
Muller GmbH
8
Maier GmbH & Co. KG
Mayer GmbH & Co. KG
Meyer GmbH & Co. KG
Meier GmbH & Co. KG
Mair GmbH & Co. KG
9
Mustermann KG
Muttermann KG
Mutsermann KG
Musterman KG
10
Ich AG
Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016
