Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
Hallo liebe Excelgemeinde,
bräuchte mal wieder eure Hilfe! :)
Mif folgendem Code (Auszug) wird per vlookup in der ersten Spalte gesucht ob die aktuelle Artikelnummer vorhanden, wenn ja werden dann entsprechend die Zellen rechts daneben ausgegeben!
Code: Dim rngA As Range
Dim rngB As Range
If Target.Column = 1 Then
Set rngA = Cells(Target.Row, 1)
Set rngB = Range("A:O")
If IsError(Application.VLookup(rngA, rngB, 5, False)) Then
Cells(Target.Row, 2).Value = ""
Cells(Target.Row, 3).Value = ""
Cells(Target.Row, 4).Value = ""
Cells(Target.Row, 5).Value = ""
Cells(Target.Row, 6).Value = ""
Cells(Target.Row, 7).Value = ""
Cells(Target.Row, 8).Value = ""
Cells(Target.Row, 9).Value = ""
Cells(Target.Row, 10).Value = ""
Cells(Target.Row, 11).Value = ""
Cells(Target.Row, 12).Value = ""
Cells(Target.Row, 13).Value = ""
Cells(Target.Row, 14).Value = ""
Cells(Target.Row, 15).Value = ""
Else
Cells(Target.Row, 5).Value = Application.VLookup(rngA, rngB, 5, False)
Cells(Target.Row, 6).Value = Application.VLookup(rngA, rngB, 6, False)
Cells(Target.Row, 7).Value = Application.VLookup(rngA, rngB, 7, False)
Cells(Target.Row, 8).Value = Application.VLookup(rngA, rngB, 8, False)
Cells(Target.Row, 9).Value = Application.VLookup(rngA, rngB, 9, False)
Cells(Target.Row, 10).Value = Application.VLookup(rngA, rngB, 10, False)
Cells(Target.Row, 11).Value = Application.VLookup(rngA, rngB, 11, False)
Cells(Target.Row, 12).Value = Application.VLookup(rngA, rngB, 12, False)
Cells(Target.Row, 13).Value = Application.VLookup(rngA, rngB, 13, False)
Cells(Target.Row, 14).Value = Application.VLookup(rngA, rngB, 14, False)
Cells(Target.Row, 15).Value = Application.VLookup(rngA, rngB, 15, False)
End If
Application.EnableEvents = True
End If
ActiveSheet.Protect Password:="999"
End Sub
Nun das funktioniert perfekt! Nur dass wenn ich mehrere Artikelnummer gleichzeitig in der Spalte 1 einfüge, dann wird nur der erste Wert gesucht und entsprechend die Werte dazu ergänzt, die anderen nicht! Wie muss ich den Code ändern, damit alle Werte die ich einfüge gesucht werden und etnsprechend die Zeilen ergänzt werden? Ist das überhaupt möglich mit vlookup?
Vielen Dank im Voraus
Viele Grüße
Alexandra
Registriert seit: 13.04.2014
Version(en): 365, 2019
Hallo,
Dir ist schon klar, dass das Makro, wenn es Deine Wünsche erfüllen soll, vorhandene Daten in den Zeilen überschreibt?
Außerdem kann Dein Makro immer nur die erste Zeile finden, da der Suchbegriff im Suchbereich steht.
Abgesehen davon, würde ich das anders angehen:
Code: Dim rngA As Range
Dim rngB As Range
If Target.Column = 1 Then
Set rngA = Cells(Target.Row, 1)
dim loA as long
If IsError(Application.match(rngA, Range("A:A", 0)) Then
Range(Cells(target.row,5),cells(target.row,15)=""
Else
loA=Application.match(rngA, Range("A:A", 0)
range(cells(loa,5),cells(loa,15).copy destination:=range(cells(Target.row,5),cells(target.row,15)
End If
Application.EnableEvents = True
End If
ActiveSheet.Protect Password:="999"
End Sub
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
Hi Edgar,
danke für dein Beitrag!
Dein Code habe ich eingefügt, aber dieses Teil hier ist rot:
Code: If IsError(Application.match(rngA, Range("A:A", 0)) Then
Range(Cells(target.row,5),cells(target.row,15)=""
Else
loA=Application.match(rngA, Range("A:A", 0)
range(cells(loa,5),cells(loa,15).copy destination:=range(cells(Target.row,5),cells(target.row,15)
Ne Ahnung woran das liegt?
Danke
VG
Alexandra
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo zusammen,
so wie ich es verstehe, sind beide Versionen nicht wirklich nützlich.
In beiden wird die Eingabe in der Eingabespalte gesucht. Das ist natürlich dann auch die Eingabe und auch die Eingabezeile.
Außerdem ist das abarbeiten von mehreren Zeilen so auch nicht möglich.
Alexandra, könntest Du nicht einen Tabellenausschnitt einstellen und darauf basierend erklären, was Du erreichen möchtest.
Gruß Atilla
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
Hallo Atilla,
hier der Link:
[ Dateiupload bitte im Forum! So geht es: Klick mich!]
Wenn in Spalte A10 nun 111111 eingebe, dann ergänzt mir der Code momentan die Zellen E10-N10 mit den vorhanden Daten da ja der Artikel schon existiert in der Tabelle! Wenn ich 222222 eingeben dann ebenfalls wird alles schön ergänzt! Wenn ich aber nun aus einer anderen Datei z.B. zwei Zellen kopiere in der einen steht 111111 und in der anderen 222222 und ich diese gleichzeitig in der Spalte A in dem Beispiel A10 und A11 einfüge, dann ergänzt mir der Code nur die erste Zeile! Ich hätte gerne dass er mir jeweils die Zellen ergänzt! Könne auch 100 Nummern werden!
Vereinfacht gesagt, dass was jetzt passiert wenn ich nur eine Nummer eingebe passiert, soll für mehrere Nummern gleichzeigt passieren, damit ich nicht jede Nummer per Hand eingeben muss!
Ich hoffe ich habe mich einigermaßen verständlich ausgedrückt!
Vielen Dank im Voraus
LG
Alexandra
Registriert seit: 13.04.2014
Version(en): 365, 2019
Hallo atilla,
du hast wohl recht, dass mein Makro das Problem nicht löst, mir war es nur darum gegangen, aufzuzeigen, wo man kürzen könnte, unabhängig von den Punkten, die ich bemängelt habe. Das, was die Datei bietet ist aber erschreckend. Da ist wirklich die Frage, was soll das werden???
Da sollte Alexandra aber mal eine ganze Menge Info rüberwachsen lassen!
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo Alexandra,
soweit habe ich Dein Anliegen jetzt verstanden.
So wie Edgar auch feststellt, ist da noch viel Vereinfachungs-Potenzial, was Deine Code betrifft.
Auf jeden Fall solle man einige Zeilen einsparen können.
Könntest Du noch ein Beispiel geben, was Du mit dem Substitute erreichen möchtest.
Möchtest Du Leerstings bereinigen?
Gruß Atilla
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo Alexandra,
ich habe das mit dem Ersetzen mal außen vor gelassen und den anderen Teil unten im Code eingearbeitet.
Code: Private Sub Worksheet_Change(ByVal Target As Range)
Dim varZ As Variant
Dim lngZ As Long, i As Long
If Target.Column = 1 And Target.Row > 2 Then
On Error GoTo errorhandler
Application.EnableEvents = False
lngZ = Selection.Rows.Count + Target.Row - 1
For i = Target.Row To lngZ
varZ = Application.Match(Cells(i, 1), Range("A3:A" & Target.Row - 1), 0)
If IsNumeric(varZ) Then
Range(Cells(i, 5), Cells(i, 15)).Value = Range(Cells(varZ, 5), Cells(varZ, 15)).Value
Else
Range(Cells(i, 5), Cells(i, 15)).ClearContents
End If
Next i
End If
errorhandler:
Application.EnableEvents = True
If Err Then MsgBox "Fehler-Nr.: " & Err.Number & vbLf & vbLf & Err.Description
End Sub
Gruß Atilla
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
31.03.2015, 18:12
(Dieser Beitrag wurde zuletzt bearbeitet: 31.03.2015, 18:14 von cysu11.)
Hallo lieber Atilla,
das mit dem Substitute hattest du mir noch zur "CF"-Zeiten :) geschrieben, dass soll aus "111111" das machen "11 11 11" aber darum geht es mir nicht, das funktioniert perfekt! Selbst wenn ich mehrere Zahlen einfüge untereinander funktioniert das! :)
Hier in meine Beispieldatei:
[ Dateiupload bitte im Forum! So geht es: Klick mich!]
Wenn du hier z.B. in A9 die Zahl 222222 eingibst, dann füllt der Code in dieser Zeile ab Spalte E bis N die Zellen mit "Birnen" weil ja die "222222" in der Zeile 4 schon vorkommt. Wenn du z.B. 555555 eingibst dann passiert nichts weiter, da ja die 555555 noch nicht vorhanden ist! Wenn du aber stattdessen z.B. die drei rotmarkierten Zahlen in C22 bis C24 per "strg+c" gleichzeitig kopierst und in A9 bis A11 per "Werte einfügen" einfügst dann füllt der Code nur die Zellen für den ersten Wert in dem Fall nur für die 111111 entsprechend mit "Apfel" auf. Bei den anderen zwei Werte die kopiert und eingefügt hast, da erscheint nichts in der Zeile obwohl ja die Zahlen bereits in der Tabelle vorhanden! Und genau das ist es was ich möchte!
Kurz gesagt, wenn ich mehrere Zahlen gleichzeitig in der Spalte A einfüge dann soll der Code prüfen:
1. Gibt es diese Zahlen schon?
2. Wenn ja, dann kopiere die dazugehörigen Daten aus der Spalte E bis N
3. Wenn nein dann nichts
Ich hoffe jetzt ist bissi verständlicher :20:
Vielen Dank im Voraus
LG
Alexandra
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo Alexandra,
dann teste mal folgenden Code:
Code: Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varZ As Variant
Dim lngZ As Long, i As Long
If Target.Column = 1 And Target.Row > 2 Then
On Error GoTo errorhandler
Application.EnableEvents = False
lngZ = Selection.Rows.Count + Target.Row - 1
For i = Target.Row To lngZ
Select Case Len(Application.Substitute(Cells(i, 1), " ", ""))
Case 6
Cells(i, 1) = Left(Application.Substitute(Cells(i, 1), " ", ""), 2) & _
" " & Mid(Application.Substitute(Cells(i, 1), " ", ""), 3, 2) & _
" " & Right(Application.Substitute(Cells(i, 1), " ", ""), 2)
Case 9
Cells(i, 1) = Left(Application.Substitute(Cells(i, 1), " ", ""), 3) & _
" " & Mid(Application.Substitute(Cells(i, 1), " ", ""), 4, 3) & _
" " & Right(Application.Substitute(Cells(i, 1), " ", ""), 3)
End Select
varZ = Application.Match(Cells(i, 1), Range("A3:A" & Target.Row - 1), 0)
If IsNumeric(varZ) Then
Range(Cells(i, 5), Cells(i, 15)).Value = Range(Cells(varZ + 2, 5), Cells(varZ + 2, 15)).Value
Else
Range(Cells(i, 5), Cells(i, 15)).ClearContents
End If
Next i
Range(Cells(3, 16), Cells(i - 1, 46)).Select
Range(Cells(3, 16), Cells(i - 1, 46)).Formula = Range(Cells(3, 16), Cells(3, 46)).Formula
End If
errorhandler:
Application.EnableEvents = True
If Err Then MsgBox "Fehler-Nr.: " & Err.Number & vbLf & vbLf & Err.Description
End Sub
Gruß Atilla
|