Alternative zu vlookup!

[cysu11]

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

[BoskoBiati]

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

[cysu11]

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

[atilla]

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.

[cysu11]

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

[BoskoBiati]

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!

[atilla]

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?

[atilla]

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

[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

[atilla]

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