Meldung kommt nicht

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
"...Hatte gehofft, daß ich den gleichen Code wohl in allen Blätter reinkopieren kann...."
Du bist ein kleiner Scherzkeks :-)
Hellsehen kann EXCEL nicht.
Du musst den Code auf jede Tabelle kopieren WO EINE EINGABE erfolgt UND den Eingabebereich natürlich anpassen,... oder woher soll EXCEL wissen welcher Bereich geprüft werden soll
Hier eine Alternative die zumindest zentral verwaltet werden kann
'In das Klassenmodul "Diese Arbeitsmappe"


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Sh.Name
Case "Tabelle1"
With Sh
'Zellbezüge anpassen
If Not Intersect(Target, Sh.Range("C5:C" & Sh.Cells(Sh.Rows.Count, "C").End(xlUp). _
Row)) Is Nothing And Target.Count = 1 Then
If Application.CountIf(Sh.Range("C5:C" & Target.Row), Target) > 1 Then _
MsgBox "Nummer ist schon vorhanden!"
Exit Sub
End If
End If
End With
Case Tabelle2
With Sh
'Zellbezüge anpassen
If Not Intersect(Target, Sh.Range("C5:C" & Sh.Cells(Sh.Rows.Count, "C").End(xlUp). _
Row)) Is Nothing And Target.Count = 1 Then
If Application.CountIf(Sh.Range("C5:C" & Target.Row), Target) > 1 Then _
MsgBox "Nummer ist schon vorhanden!"
Exit Sub
End If
End If
End With
Case Tabelle3
With Sh
'Zellbezüge anpassen
If Not Intersect(Target, Sh.Range("C5:C" & Sh.Cells(Sh.Rows.Count, "C").End(xlUp).Row))  _
Is Nothing And Target.Count = 1 Then
If Application.CountIf(Sh.Range("C5:C" & Target.Row), Target) > 1 Then _
MsgBox "Nummer ist schon vorhanden!"
Exit Sub
End If
End If
End With
End Select
End Sub

Alle anderen Codes aus den jeweiligen Tabellen müssen gelöscht werden
Gruss Rainer

Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = True On Error GoTo errExit Application.EnableEvents = False If Target.Count = 1 Then If Not IsEmpty(Target) Then If Not Intersect(Target, Range("B5:B" & Application.Max(5, Cells(Rows.Count, "B").End(xlUp).Row) _ )) Is Nothing Then If Application.CountIf(Tabelle3.Range("C5:C" & Target.Row), Target) > 1 Then _ MsgBox "Nummer ist schon vorhanden!" Target.Value = "": Target.Select End If End If End If errExit: Application.EnableEvents = True End Sub

Hallo Gerd
Cooler Code. Leider ist es nicht was ich mir vorgestellt habe.
Es sind etwa 30 Tabelleblätter. In den einzelnen Tabs sind solche gelben Spalten, teilweise zusammengehängt, teilweis auch in mehreren Blöcken.
Aber alle Zellen haben eines gemeinsam. Sie sind alle mit dem Tabellenblatt Nr. 3 untereinander verknüpft, sodaß in der Tabelle Nr. in einer Spalte alle erdenklichen Zahlen untereinander aufgelistet sind.
Von dort habe ich die bessere Uebersicht ob eine Zahl doppelt ist. (Wie zb. 10 in einer Zeile und ein paar Zeilen weiter unten nochmals die 10. Dann sollte eben eine Meldung kommen. Wenn ich es im gleichen Tabelleblatt versuche geht es. Wenn ich es aber mit verbundenen Zellen mache geht es nicht.
Ich verstehe es nicht. Ob ich es in der Zelle C3 im Tab3 eintippe oder mittels Verknüpfung von Tabelle 1 oder 2 etc. auf die gleiche Zelle C3 zugreifen.
Gruß
Patrick

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) On Error GoTo errExit Application.EnableEvents = False If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub If Not IsNumeric(Target.Value) Then Exit Sub If Sh.Name = "Tabelle3" Then Exit Sub Select Case Sh.Name Case "Tabelle1", "Tabelle2" If Intersect(Target, Range("B5:b15")) Is Nothing Then Exit Sub Case "Tabelle4" If Intersect(Target, Range("B5:b15,b20:b25")) Is Nothing Then Exit Sub Case "Tabelle5" End Select If Application.CountIf(Worksheets("Tabelle3").Columns("C:C"), Target.Value) > 1 Then MsgBox "Wert bereits vorhanden" Target.Value = "": Target.Select End If errExit: Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread