Vlookup Problem

[cysu11]

Hallo liebe Excel-Gemeinde,


bin mal wieder am Basteln und benötige wieder mal eure Hilfe! :)

Folgenden code habe ich, dieser bringt aber mein Excel immer zum Absturz:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Wsf As WorksheetFunction
Dim Bereich As Range
Set Bereich = Tabelle4.Range("A2:E3")
Set Wsf = Application.WorksheetFunction
Tabelle50.Cells(19, 1).Value = Wsf.VLookup(Tabelle50.Cells(18, 1).Value, Bereich, 2, False)
Tabelle50.Cells(20, 1).Value = Wsf.VLookup(Tabelle50.Cells(18, 1).Value, Bereich, 3, False)
Tabelle50.Cells(22, 1).Value = Wsf.VLookup(Tabelle50.Cells(18, 1).Value, Bereich, 4, False) & " " & Wsf.VLookup(Tabelle50.Cells(18, 1).Value, Bereich, 5, False)
'Tabelle50.Cells(23, 1).Value = Wsf.VLookup(Tabelle50.Cells(18, 1).Value, Bereich, 5, False)
Tabelle50.Cells(27, 1).Value = Wsf.VLookup(Tabelle50.Cells(18, 1).Value, Bereich, 5, False)
End Sub

Ich habe in Tabelle50 in der Zelle A18 ein Dropdown über die Datenüberprüfung eingefügt, hier wähle ich den KUndenname aus der Liste in Tabelle4 SpalteA. Ich möchte, dass die dazugehörigen Daten aus Spalte B, C, D und E jeweils dann in der Tabelle50 in Zellen A19, A20, A21 und A22 je nach Auswahl in den Dropdown entsprechen übertragen werden! Wenn A18 leer oder ein Name eingegeben wird der nicht in der Liste ist, sollen  A19, A20, A21 und A22 geleert werden!
Kann mir jemand hier helfen? :)
Vielen Dank
VG
Alexandra

[Kuwer]

Hallo Alexandra,

so sollte es gehen:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Wsf As WorksheetFunction
 Dim Bereich As Range
 If Target.Address = "$A$18" Then
   Set Bereich = Tabelle4.Range("A2:E3")
   Set Wsf = Application.WorksheetFunction
   Me.Cells(19, 1).Value = Wsf.VLookup(Target.Value, Bereich, 2, False)
   Me.Cells(20, 1).Value = Wsf.VLookup(Target.Value, Bereich, 3, False)
   Me.Cells(22, 1).Value = Wsf.VLookup(Target.Value, Bereich, 4, False) & " " & Wsf.VLookup(Target.Value, Bereich, 5, False)
   'Me.Cells(23, 1).Value = Wsf.VLookup(Target.Value, Bereich, 5, False)
   Me.Cells(27, 1).Value = Wsf.VLookup(Target.Value, Bereich, 5, False)
 End If
End Sub

Gruß Uwe

[cysu11]

Hallo Uwe,


funktioniert soweit gut, nur wenn ich einen Namen eingebe der nicht in der Liste vorhanden ist, dann sollen die Felder geleert werden oder wenn ich den Namen aus A18 entferne bzw. A18 leer ist, dann sollen auch die anderen Werte entfernt werden! Könntest du da mir nochmals helfen? :)


Vielen Dank
VG
Alexandra

[Kuwer]

Hallo Alexandra,

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Bereich As Range
 If Target.Address = "$A$18" Then
   Set Bereich = Tabelle4.Range("A2:E3")
   On Error Resume Next
   Application.EnableEvents = False
   Me.Cells(19, 1).Value = Application.VLookup(Target.Value, Bereich, 2, False)
   If Application.IsNA(Me.Cells(19, 1).Value) Then
     Me.Cells(19, 1) = ""
     Me.Cells(20, 1) = ""
     Me.Cells(22, 1) = ""
     Me.Cells(27, 1) = ""
   Else
     Me.Cells(20, 1).Value = Application.VLookup(Target.Value, Bereich, 3, False)
     Me.Cells(22, 1).Value = Application.VLookup(Target.Value, Bereich, 4, False) & " " & Application.VLookup(Target.Value, Bereich, 5, False)
     'Me.Cells(23, 1).Value = Application.VLookup(Target.Value, Bereich, 5, False)
     Me.Cells(27, 1).Value = Application.VLookup(Target.Value, Bereich, 5, False)
   End If
   Application.EnableEvents = True
   On Error GoTo 0
 End If
End Sub

Gruß Uwe

[cysu11]

Hallo Uwe,


schaut schon sehr gut aus, eine Klenigkeit noch, wenn ich den Wert aus Tabelle50 A18 entferne, dann bleiben die anderen Felder unverändert, sollte aber auch entsprechend entfernt werden!?
Wie muss ich das machen!?


Vielen Dank
VG
Alexandra

[Kuwer]

Hallo Alexandra,

wenn ich den Wert aus Tabelle50 A18 entferne, dann bleiben die anderen Felder unverändert, sollte aber auch entsprechend entfernt werden!?
Wie muss ich das machen!?

If Application.IsNA(Me.Cells(19, 1).Value) Or Me.Cells(18, 1).Value = "" Then

Gruß Uwe

[cysu11]

Hi Uwe,


da tut sich leider nichts!? :(

Ich bin auf A18 und drücke entfernen und nichts...


Ne Idee?


Vielen Dank
VG
Alexandra

[Kuwer]

Hallo Alexandra,

da tut sich leider nichts!? :(

bei mir läuft das alles auch schon ohne die letzte Anpassung so wie Du es gern hättest.
Da ich Deinen jetzigen Stand nicht kenne, muss ich passen.

Gruß Uwe

[atilla]

Hallo Alexandra,

Tabelle50 ist doch die Tabelle in der die Eingabe passiert, richtig?

Mit obiger Annahme würde ich es so, ohne Vlookup, lösen:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x
Dim namensBereich As Range
Set namensBereich = Tabelle4.Range("A2:A3")

If Target.CountLarge = 1 Then
 If Target.Address(0, 0) = "A18" Then
 On Error GoTo fehler
 Application.EnableEvents = False
   Range("A19:A22") = ""
   Range("A27") = ""
   x = Application.Match(Target, namensBereich, 0)
   If IsNumeric(x) Then
     With Tabelle4
       Cells(19, 1) = .Cells(x + 1, 2)
       Cells(20, 1) = .Cells(x + 1, 3)
       Cells(22, 1) = .Cells(x + 1, 4) & " " & .Cells(x + 1, 5)
       Cells(27, 1) = .Cells(x + 1, 5)
     End With
   End If
 End If
End If

fehler:
 Application.EnableEvents = True
 If Err Then MsgBox "Fehler: " & Err.Number & vbLf & vbLf & Err.Description

End Sub

Wenn Du gleich schreiben möchtest, das funktioniert nicht, lass es.
Denn ich weiß, dass es funktioniert.

In dem Fall solltest Du mal schauen, ob Tabelle4 der Codename ist. Wenn es der Blattname ist (Blattregister) , dann ersetzen mit Sheets("Tabelle4")

[cysu11]

Hallo Uwe und Hallo Atilla,


nun habe ich nach langer Probiererei endlich die Ursache gefunden :), aber noch keine Lösung.
Das Zelle A18 ist eine verbundene Zelle bis Spalte F. Wenn ich die Verbindung aufhebe dann klappt es wunderbar aber wenn ich die Zellen wieder verbinde, dann geht es wieder nicht mehr!
die Zellen müssen aber zusammenbleiben, was kann man da machen?


Vielen Dank
Viele Grüße
Alexandra