doppelte Einträge ü. mehrere A.-blätter verhindern

Hallo Excel-Spezialisten,
ich wende mich an Euch, weil ich im Moment nicht weiter komme:
Ich habe eine Excel-datei mit Einträgen über mehrere Arbeitsblätter. Ich möchte nun verhindern, daß ein Eintrag doppelt vorgenommen werden kann.
Blatt 1 bis Blatt n enthält immer in Spalte A fortlaufende Nummern. Wenn ich nun ein neues Blatt beginne und wiederum in Spalte A die neuen Nummern eintrage soll verhindert werden, daß aufgrund von Tippfehlern eine Nummer doppelt vorkommt.
Habt Ihr mir hierfür eine Lösung ? Wenn möglich ohne VBA.
Evtl. denkbar wäre auch noch den doppelten Eintrag erst auf Nachfrage zuzulassen ("Achtung, Eintrag bereits vorhanden. Wollen Sie dies zulassen ?")
Gruß Paul

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet, wsNameA As String Dim s As Integer, z As Integer, Lz As Integer, i As Integer Dim Eingabe As String, Aktiv As Object Dim Weiter s = Target.Column z = Target.Row If s <> 1 Then Exit Sub Set Aktiv = ThisWorkbook.ActiveSheet wsNameA = ThisWorkbook.ActiveSheet.Name Eingabe = ThisWorkbook.ActiveSheet.Cells(z, s) For Each ws In ActiveWorkbook.Worksheets Lz = ws.Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To Lz If Eingabe <> "" Then If ws.Cells(i, 1) = Eingabe Then If ws.Name <> wsNameA Then Weiter = MsgBox("Achtung, Eintrag bereits in " & ws.Name & _ " vorhanden. Wollen Sie dies zulassen?", vbYesNo) If Weiter = vbNo Then Aktiv.Cells(z, 1) = "" Aktiv.Cells(z, 1).Select Exit Sub End If End If End If End If Next i Next ws Lz = Aktiv.Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To Lz - 1 If Aktiv.Cells(i, 1) = Eingabe Then Weiter = MsgBox("Achtung, Eintrag bereits in aktiver Tabelle vorhanden. Wollen Sie dies zulassen?", _ vbYesNo) If Weiter = vbNo Then Aktiv.Cells(z, 1) = "" Aktiv.Cells(z, 1).Select Exit Sub End If End If Next i End Sub

Hi,
freut mich, dass es klappt.
OPTION EXPLICIT erzwingt das Deklarieren der Variablen. Die verwendung nicht deklarierter Variablen führt zu einem Fehler beim Kompilieren, kannst Du in der Onlinehilfe gut nachlesen. Vor allem bei großen Projekten kann man sich viel Fehlersuchen sparen, wenn die Variablen deklariert werden _müssen_.
"Worksheet_Change" funktioniert leider nur in den einzelnen Tabellen, nicht in "Diese Arbeitsmappe".
Um den selben Code nicht in jeder Tabelle zu benötigen kannst Du folgendes ändern:
Code in den Arbeitsblättern:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As Integer, z As Integer
s = Target.Column
z = Target.Row
If s <> 1 Then Exit Sub
Call Doppelte_suchen(z, s)
End Sub

In ein Standard-Modul (Ansicht/Einfügen/Modul) kommt dann folgender Code:
Sub Doppelte_suchen(z As Integer, s As Integer)
Dim ws As Worksheet, wsNameA As String
Dim Lz As Integer, i As Integer
Dim Eingabe As String, Aktiv As Object
Dim Weiter
Set Aktiv = ThisWorkbook.ActiveSheet
wsNameA = ThisWorkbook.ActiveSheet.Name
Eingabe = ThisWorkbook.ActiveSheet.Cells(z, s)
For Each ws In ActiveWorkbook.Worksheets
Lz = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Lz
If Eingabe "" Then
If ws.Cells(i, 1) = Eingabe Then
If ws.Name wsNameA Then
Weiter = MsgBox("Achtung, Eintrag bereits in " & ws.Name & _
" vorhanden. Wollen Sie dies zulassen?", vbYesNo)
If Weiter = vbNo Then
Aktiv.Cells(z, 1) = ""
Aktiv.Cells(z, 1).Select
Exit Sub
End If
End If
End If
End If
Next i
Next ws
Lz = Aktiv.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Lz - 1
If Aktiv.Cells(i, 1) = Eingabe Then
Weiter = MsgBox("Achtung, Eintrag bereits in aktiver Tabelle vorhanden. Wollen Sie dies zulassen?", _
vbYesNo)
If Weiter = vbNo Then
Aktiv.Cells(z, 1) = ""
Aktiv.Cells(z, 1).Select
Exit Sub
End If
End If
Next i
End Sub
Gruß
Albin

Sub Doppelte_suchen(z As Integer, s As Integer) Dim ws As Worksheet, wsNameA As String Dim Lz As Integer, i As Integer Dim Eingabe As String, Aktiv As Object Dim Weiter Set Aktiv = ThisWorkbook.ActiveSheet wsNameA = ThisWorkbook.ActiveSheet.Name Eingabe = ThisWorkbook.ActiveSheet.Cells(z, s) For Each ws In ActiveWorkbook.Worksheets Lz = ws.Cells(Rows.Count, s).End(xlUp).Row For i = 1 To Lz If Eingabe <> "" Then If ws.Cells(i, s) = Eingabe Then If ws.Name <> wsNameA Then Weiter = MsgBox("Achtung, Eintrag bereits in " & ws.Name & _ " vorhanden. Wollen Sie dies zulassen?", vbYesNo) If Weiter = vbNo Then Aktiv.Cells(z, s) = "" Aktiv.Cells(z, s).Select Exit Sub End If End If End If End If Next i Next ws Lz = Aktiv.Cells(Rows.Count, s).End(xlUp).Row For i = 1 To Lz - 1 If Aktiv.Cells(i, s) = Eingabe Then Weiter = MsgBox("Achtung, Eintrag bereits in aktiver Tabelle vorhanden. Wollen Sie dies zulassen?", _ vbYesNo) If Weiter = vbNo Then Aktiv.Cells(z, s) = "" Aktiv.Cells(z, s).Select Exit Sub End If End If Next i End Sub

Beliebteste Forumthreads (12 Monate)

doppelte Einträge ü. mehrere A.-blätter verhindern

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

doppelte Einträge ü. mehrere A.-blätter verhindern

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread