AW: doppelte Einträge ü. mehrere A.-blätter verhin
29.01.2006 18:19:06
Albin
Hi,
hier mal ein Vorschlag mit Makro, vermutlich ein bissl umständlich sollte aber funktionieren.
Option Explicit
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
Du kopierst den Code in das Codemodul der Tabelle. Beim Einfügen neuer Arbeitsblätter daran Denken dass Du den Code auch dort brauchst (einfach das letzte Arbeitsblatt kopieren).
Gruß
Albin