Meldung kommt nicht

Patrick · 2009-01-16T22:17:15+00:00

Hallo Leute Komme nicht mehr weiter. In der Tabelle3 kann ich Zahlen eingeben und sofern diese Zahl doppelt erfasst wird kommt eine Meldung. Wenn ich aber die Zahlen von der Tabelle1 aus in Tabelle3 mit einer Verknüpfung verbinde und von Tabelle1 die Zahlen eingeben und zwar auch gleiche Zahlen bekomme ich keine Melung. Ich bin am Verzweifeln war dies so ist. Wäre nett wenn jemand von Euch dies anschauen würde bevor ich vollends absaufe. Die Datei https://www.herber.de/bbs/user/58500.xls wurde aus Datenschutzgründen gelöscht Danke vorab Patrick

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

Hallo Patrick,
Formeln sind keine Links u. keine "Verbundenen Zellen". Sie werden allenfalls mal bei externen Bezügen
als Verknüpfungen bezeichnet.
'modul DieseArbeitsmappe -- sonst nix.


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

Ist für weitere Tabellen u. evtl. in Tabelle3, spalte C noch anzupassen.
Falls mal ein Fehler beim Testen auftritt:
Ggf. die Events neu einstellen mit
Sub egal()
Application.Enableevents=true
End Sub

Gruß Gerd

Forumthread: Meldung kommt nicht

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Meldung kommt nicht

Forumthread: Meldung kommt nicht

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread