Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


Alternative zu vlookup!
#1
Hallo liebe Excelgemeinde,


bräuchte mal wieder eure Hilfe! Smile

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
to top
#2
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.
to top
#3
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
to top
#4
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

Excel 2007
to top
#5
Hallo Atilla,


hier der Link:

https://www.dropbox.com/s/zpqvsxumcljnll....xlsm?dl=0


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
to top
#6
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.
to top
#7
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

Excel 2007
to top
#8
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

Excel 2007
to top
#9
Hallo lieber Atilla,


das mit dem Substitute hattest du mir noch zur "CF"-Zeiten Smile 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! Smile

Hier in meine Beispieldatei:

https://www.dropbox.com/s/zpqvsxumcljnll....xlsm?dl=0

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
to top
#10
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

Excel 2007
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  Textbox via Vlookup füllen Tuempeltaucher 6 168 22.09.2016, 12:18
Letzter Beitrag: Tuempeltaucher
  Text spalten in alternative hisid1 5 170 12.09.2016, 12:27
Letzter Beitrag: steve1da
  DBMIN(?) Alternative? Travis5002 5 247 24.08.2016, 11:10
Letzter Beitrag: Travis5002
  Alternative zu Wenn und bzw oder Funktion Antihero 6 573 25.06.2016, 12:39
Letzter Beitrag: Ego
  Alternative zu WENN DANN Verschachtelung drarrr 7 627 12.04.2016, 14:07
Letzter Beitrag: drarrr
  Spiele zählen; ZÄHLENWENNS, oder Alternative!? basti1912 12 1.069 30.03.2016, 21:00
Letzter Beitrag: basti1912
  Alternative für After := ActiveCell bei der Suche in einem Range-Objekt ChristaRohn 14 1.074 17.03.2016, 19:43
Letzter Beitrag: RPP63
  Alternative Nummern anhand mehrerer Bedingungen Reismann 15 1.006 12.02.2016, 15:38
Letzter Beitrag: Reismann
  ActiveX - Alternative? guenther-st 5 1.335 11.10.2015, 11:19
Letzter Beitrag: guenther-st
  Summenprodukt Alternative floridarolf 12 2.827 02.02.2015, 16:48
Letzter Beitrag: Rabe

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste