VBA Worksheet Ereignis

Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet, rng As Object, ws2 As Worksheet Dim lastrow As Integer, c As Integer, lastrowws As Integer Application.ScreenUpdating = False Set ws = ActiveSheet lastrow = ws.Range("B1048576").End(xlUp).Row If Intersect(ActiveCell, Range("B1:B" & lastrow)) Is Nothing Then c = Target.Row lastrowws = Tabelle2.Range("C1048576").End(xlUp).Row Set rng = Tabelle2.Range(Tabelle2.Cells(4, 4), Tabelle2.Cells(lastrowws, 4)).Find(what:= _ Target.Value, LookAt:=xlWhole) If Not rng Is Nothing Then ws.Cells(c, 3) = Tabelle2.Cells(rng.Row, 4) Else End If End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
sorry, aber das ist etwas wirr.
Ich bin mal von folgendem ausgegangen:
-du gibst in BlattA in Spalte B Werte ein
-den eingegebenen Wert willst du in BlattB in Spalte D suchen
-bei Fund den Wert aus BlattB Spalte E in BlattA Spalte C ausgeben
das wäre der von dir beschriebene SVERWEIS
Das lässt sich einfach dadurch erledigen, dass du per Code eine SVERWEIS-Formel in BlattA in der jeweiligen Zelle in Spalte C einträgst und dann die Formel durch den entsprechende Wert ersetzt.
Ich habe die Formel jetzt mal mit WENNFEHLER ergänzt, für den Fall, dass der Suchbegriff nicht gefunden wurde.
Teste mal:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim loLetzteQ As Long, loLetzteZ As Long
If Target.Column  2 Then Exit Sub
If Target.Count > 1 Then
MsgBox "Keine Mehrfacheingabe zulässig."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
loLetzteZ = Cells(Rows.Count, 2).End(xlUp).Row
loLetzteQ = Worksheets("Tabelle2").Cells(Worksheets("Tabelle2").Rows.Count, 4).End(xlUp).Row
If Not Intersect(Range("B1:B" & loLetzteZ), Target) Is Nothing Then
If Target.Value = "" Then
Target.Offset(, 1).ClearContents
Else
Target.Offset(, 1).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-1],Tabelle2!RC[1]:R[" & loLetzteQ & "]C[2],2,FALSE),""nicht  _
gefunden"")"
Target.Offset(, 1).Value = Target.Offset(, 1).Value
End If
End If
End Sub

Gruß Werner

Morrn, Shayev;
&bullet; Set ws = ActiveSheet ist in einer EreignisProzedur des Blattes Quatsch, denn sie reagiert ja nur dann auf Ereignisse, wenn sie in ihrem Blatt auftreten, das dann natürlich das aktive ist. ws kannst du also einsparen und stattdessen ggf Me. verwenden, was sich auf dieses Blatt bezieht.
&bullet; ActiveCell ist ebenfalls Quatsch, denn Target ist hier ursprünglich die aktive(n) ÄnderungsZelle(n).
&bullet; Das dürfte aber wohl den Fehler nicht beseitigen, weshalb du auf dieser Zeile einen HaltePkt setzen und den aktuellen Wert von lastrowws überprüfen solltest!
Gruß, Luc :-?
„Die Intelligenzmenge ist auf diesem Planeten eine Konstante, die Bevölkerung nimmt aber zu!“ Auch deshalb informieren mit …

Private Sub Worksheet_Change(ByVal Target As Range) Dim loLetzteQ As Long, loLetzteZ As Long If Target.Column 2 Then Exit Sub If Target.Count > 1 Then MsgBox "Keine Mehrfacheingabe zulässig." Application.EnableEvents = False Application.Undo Application.EnableEvents = True Exit Sub End If loLetzteZ = Cells(Rows.Count, 2).End(xlUp).Row loLetzteQ = Worksheets("Tabelle2").Cells(Worksheets("Tabelle2").Rows.Count, 4).End(xlUp).Row If Target.Column = 2 And Target.Value = "" Then Target.Offset(, 1).ClearContents If Not Intersect(Range("B1:B" & loLetzteZ), Target) Is Nothing Then If Target.Value "" Then Target.Offset(, 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-1],Tabelle2!RC[1]:R[" & loLetzteQ & "]C[2],2,FALSE),""nicht _ gefunden"")" Target.Offset(, 1).Value = Target.Offset(, 1).Value End If End If End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread