Clever-Excel-Forum

Seiten: 1 2 3

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

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

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

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

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

Hallo Alexandra,

(13.06.2017, 15:39)cysu11 schrieb: [ -> ]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

Hi Uwe,

da tut sich leider nichts!? :(

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

Ne Idee?

Vielen Dank
VG
Alexandra

Hallo Alexandra,

(13.06.2017, 15:49)cysu11 schrieb: [ -> ]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

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. Blush

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")

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

Seiten: 1 2 3

cysu11

Kuwer

cysu11

Kuwer

cysu11

Kuwer

cysu11

Kuwer

atilla

cysu11