Zellenwerte prüfen

Hallo VBAler,
ich möchte prüfen, ob die Zellenwerte aus der aktiven Zelle in Spalte B bereits in selbiger Spalte vorhanden sind. Geprüft werden soll ab B11, die erste Eingabe erfolgt ab B10.
Falls der Wert der aktiven Zelle in Spalte B nicht gefunden wird, soll nichts passieren, falls doch sollen alle Inhalte von 5 Zellen neben dem gefundenen Werte in die aktiven Reihe kopiert werden und die 3. Zelle von rechts von der aktiven selektiert werden.
Das Makro funktioniert soweit, jedoch wird immer die 3. Zelle aktiviert, auch wenn der Wert in Spalte B nicht existiert. Weiß jmd. wo der Fehler liegt?
Gruß
Chris
Dim Zelle2 As Range
Dim SearchArea As Long
Dim lngzelle3 As Long
SearchArea = ActiveSheet.Range("B:B").Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, _
searchorder:=xlByRows, SearchDirection:=xlPrevious).Row - 1 'Suchbereich = AktiveZelle -1
lngzelle3 = ActiveSheet.Range("B:B").Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, _
searchorder:=xlByRows, SearchDirection:=xlPrevious).Row - 1
'WSChange-Anwendung bis jeweils akive Zelle
If Not Intersect(Target, Range("B11:B" & lngzelle3)) Is Nothing Then
Application.EnableEvents = False
For Each Zelle2 In Intersect(Target, Range("B11:B" & lngzelle3))
Set c = ActiveSheet.Range("B11:B" & SearchArea).Find(Zelle2.Value, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True, searchorder:=xlByRows)
If Not c Is Nothing Then
Zelle2.Offset(, 1).Value = c.Offset(, 1).Value
Zelle2.Offset(, 2).Value = c.Offset(, 2).Value
Zelle2.Offset(, 4).Value = Format(c.Offset(, 4).Value, "hh:mm")
Zelle2.Offset(, 5).Value = Format(c.Offset(, 5).Value, "hh:mm")
Zelle2.Offset(, 3).Activate
End If
Next
Application.EnableEvents = True
End If

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim Z As Range 'Lauf-Variable so kurz wie möglich Dim Result As Range Application.EnableEvents = False 'On Error Resume Next 'Ausschalten, wenn man testen möchte '1. Reagieren, nur wenn die Eingabe vor Zeile 11 passiert If Not Intersect(Target, Range("B1:B9")) Is Nothing Then For Each Z In Intersect(Target, Range("B1:B9")) Set Result = Nothing '2. Suchen in B11:Bxx (bei Find optimiert Excel selber den Suchbereich) Set Result = Me.Range("B10:B9999").Find(Z.Value, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True, searchorder:=xlByRows) If Not Result Is Nothing Then Z.Offset(0, 1).Value = Result.Offset(0, 1).Value Z.Offset(0, 2).Value = Result.Offset(0, 2).Value Z.Offset(0, 3).Value = Result.Offset(0, 3).Value Z.Offset(0, 4).Activate End If Next End If Application.EnableEvents = True End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim schon_da As Range If Not Intersect(Target, Range("B11:B" & Rows.Count)) Is Nothing Then If Not IsEmpty(Target) And Not IsArray(Target) Then Application.EnableEvents = False schon_da = Range("B10:B" & Target.Row - 1).Find(Target.Value, xlValues, xlWhole) If Not schon_da Is Nothing Then Target.Offset(0, 1).Resize(1, 3) = schon_da.Offset(0, 1).Resize(1, 3) Target.Offset(0, 4).Activate End If Application.EnableEvents = True Set schon_da = Nothing End If End If End Sub

Hallo Chris,
nicht


schon_da = Range("B10:B" & Target.Row - 1).Find(Target.Value, xlValues, xlWhole)

sondern


Set schon_da = Range("B10:B" & Target.Row - 1).Find(Target.Value, xlValues, xlWhole)

Es liegt daran, dass das Ergebnis einen Range ist, also ein existierenden Objekt. Objekte werden nicht als ganzes übergeben, sondern nur den "Zeiger" auf dem Objekt. Die Variable "schon_da" enthält nicht das Objekk, sondern eine Adresse, die sagt wo das Objekt (im Speicher) zu finden ist. Diese Zeiger werden immer mit Set gesetzt. Es ist auch damit verbunden, dass nicht "schon_da" auswertbar ist, sondern einen Eigenschaft davon: schon_da.Value oder schon_da.Address.
(wobei -Klugscheisser-Modus an- "Value" das Default-Eigenschaft eines Ranges ist, daher könnte man nur "schon_da" abfragen und eine Wert bekommen, aber es setzt voraus, dass diese Range eine einzige Zelle darstellt. Sonst bekommt man eine Fehler -Klugscheisser-Modus aus-)
Es ist übrigens gleichwertig zu


Set schon_da = Range("B:B").Find(Target.Value, xlValues, xlWhole)

Da Excel selber nur den "UsedRange" für die Suche in Betracht zieht.
VG
Yal

Private Sub Worksheet_Change(ByVal Target As Range) Dim schon_da As Range If Not Intersect(Target, Range("B11:B" & Rows.Count)) Is Nothing Then If Not IsEmpty(Target) And Not IsArray(Target) Then Set schon_da = Range("B10:B" & CStr(Target.Row - 1)).Find(Target.Value, , xlValues, xlWhole) If Not schon_da Is Nothing Then Target.Offset(0, 1).Value = schon_da.Offset(0, 1).Value Target.Offset(0, 2).Value = schon_da.Offset(0, 2).Value Target.Offset(0, 3).Value = schon_da.Offset(0, 3).Value Target.Offset(0, 4).Activate End If Application.EnableEvents = True Set schon_da = Nothing End If End If End Sub

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

131 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellenwerte prüfen

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

131 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread