Zwei Zellwerte miteinander vergleichen in Spalte B

Forumthread: Zwei Zellwerte miteinander vergleichen in Spalte B

16.05.2006 08:39:01

Andre´

Es werden im Bereich B1 bis F3000 Eingaben gemacht, und ich möchte mit einen Makro erreichen, dass permanent die aktive Zelleingabe (nur in der Spalte B)mit dem oberen Zellbereich verglichen wird. Wenn die zwei Werte gleich sind, dann soll eine Warnmeldung erscheinen wie z.B. sie haben den Wert schon eingetragen. Wenn das der Fall ist dann soll erst ein anderer Wert in dieser Zelle eingetragen werden. Wenn das geschehen ist, erst dann sollte eine Eingabe in den anderen Zellen möglich sein.
Es kann vorkommen, dass im aktiven Zellbereich der Spalte B der eingetragene Wert z.B.4 Zeilen weiter oben schon vorhanden ist, dann soll keine Warnmeldung erscheinen.
Hier ein Bsp.:
In B300 steht Gehen und in der Spalte B301 wird jetzt Gehen eingegeben, dann Warnmeldung. Wird in Zelle B304 Gehen eingegeben, dann keine Warnmeldung.
Hat dafür jemand eine Makrolösung!
Die Gültigkeitsprüfung habe ich bereits ausgenutzt.
Ich hoffe mir kann jemand helfen.
Danke im voraus!
Andre

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zwei Zellwerte miteinander vergleichen in Spalte B

16.05.2006 08:54:17

Harald
Korrektur

16.05.2006 09:04:53

Harald
AW: Korrektur

16.05.2006 10:02:48

Andre´
AW: Korrektur

16.05.2006 10:14:28

Andre´
AW: Korrektur

16.05.2006 10:30:30

Harald
Vielen DANK!!!

16.05.2006 10:47:51

Andre´
Danke für die Rückmeldung owT

16.05.2006 10:57:58

Harald

AW: Zwei Zellwerte miteinander vergleichen in Spalte B

16.05.2006 08:54:17

Harald

Moin Andre,
vielleicht so ?
Der Code gehört ins Blattmodul und überprüft ob in der Zell darüber ein gleicher Wert steht.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim bereich As Range
Set bereich = Range("B2:B3000")
If Target.Row = 1 Or Target.Count > 1 Then Exit Sub
If Not Intersect(Target, bereich) Is Nothing And Target.Value = Target.Offset(-1, 0).Value Then
MsgBox "Wert wurde schon eingetragen"
Target.ClearContents
Target.Select
End If
End Sub

Gruss Harald

Korrektur

16.05.2006 09:04:53

Harald

Hi nochmal,
diese Zeile
If Target.Row = 1 Or Target.Count &gt 1 Then Exit Sub
bitte durch diese ersetzen
If Target.Row = 1 Or Target.Count &gt 1 Or Target.Value = "" Then Exit Sub
Sonst gibts ggf. Probleme mit der Entf.-Taste
Gruss Harald

AW: Korrektur

16.05.2006 10:02:48

Andre´

Hallo Harald,
danke für die Meldung. Das Makro funktioniert, mir ist aufgefallen, wenn ich z.B. zwei Zellwerte kopiere und dann in einen anderen Bereich des Blattes die Werte einfüge, dann erscheint Typen unverträglich. Kommt zwar selten vor, dass kopiert und eingefügt wird aber für den Fall der Fälle hast du dafür noch etwas auf Lager!
MFG
Andre

AW: Korrektur

16.05.2006 10:14:28

Andre´

Hallo Harald,
selbst beim markieren und entfernen kommt die Fehlermeldung.
Wäre doch schön wenn du noch eine andere Lösung hast.
MFG
Andre

AW: Korrektur

16.05.2006 10:30:30

Harald

Tja, wenn man mit mehr als einer aktiven Zelle arbeitet (woher sollte ich das wissen ?), kann das mit Target natürlich nicht klappen.
;-)


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Lrow As Long
If Target.Column <> 2 Then Exit Sub
Lrow = Cells(Rows.Count, 2).End(xlUp).Row
If Lrow < 2 Or Cells(Lrow, 2) = "" Then Exit Sub
If Cells(Lrow, 2).Value = Cells(Lrow - 1, 2).Value Then
MsgBox "Schon vorhanden"
Cells(Lrow, 2).ClearContents
Cells(Lrow, 2).Select
End If
End Sub

Gruss Harald

Vielen DANK!!!

16.05.2006 10:47:51

Andre´

Hallo Harald,
danke jetzt funzt es besser!
MFG
Andre

Danke für die Rückmeldung owT

16.05.2006 10:57:58

Harald

Gruss Harald

Beliebteste Forumthreads (12 Monate)

Zwei Zellwerte miteinander vergleichen in Spalte B

Forumthread: Zwei Zellwerte miteinander vergleichen in Spalte B

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread