Prüfung auf Doppeleingabe Code macht Probleme
25.04.2026 02:14:49
Sabrina
Ich habe einen Code, welcher mich auf eine Doppeleingabe (Zahl) in Spalte A hinweist, und zwar werden alle 10 TABs überprüft. Aaaaber: Er funktioniert nur einwandfrei, wenn ich eine Testdatei erstelle, und diese neu mit Daten fülle.
Wenn ich dagegen den Code in meiner Originaldatei benutze, dann funktioniert er nur manchmal, ich konnte nicht feststellen, bei welcher Zahl er mir eine Meldung ausgibt oder einen Debugger. Es ist echt zum verrückt werden.
Es ist der einzige Code "in dieser Arbeitsmappe". Es sind keine Gültigkeiten (Datenüberprüfung) und bed. Formatierungen oder spezielle Zellformate vorhanden.
Dann hatte ich schon gedacht, meine Originaldatei ist eine uuuuuuralte .xls die natürlich Versionsabhängig immer mal wieder konvertiert wurde. Also habe ich die einzelen TABs in eine neu Mappe kopiert, dennoch kommt ein Debugger: "Laufzeitfehler 91" und dann wird der folgende Bereich markiert:
MsgBox "Lfd. Nr. " & vntItem & " ist bereits in " & wks.Name & vbNewLine & "in Zelle " & wks.Range(conDetectionRangeAddress).Find(vntItem, , xlValues).Address(0, 0) & " vorhanden!", _
vbExclamation, "A C H T U N G"
Bin echt verzweifelt, weil ich den Fehler einfach nicht finde. Ich würde ja eine Testdatei zur Verfügung stellen, aber da funktioniert er ja.
Bin sehr dankbar über eure Unterstützung. VG Sabrina
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' On Error Resume Next
Dim wks As Worksheet
Dim rngIntersect As Range
Dim rngArea As Range
Dim vntItem As Variant
Dim blnExist As Boolean
Dim lngCount As Long
Const conDetectionRangeAddress As String = "A2:A50"
With Target
Set rngIntersect = Intersect(Target, Sh.Range(conDetectionRangeAddress))
If Not rngIntersect Is Nothing Then
For Each wks In Me.Worksheets
lngCount = Abs(wks Is Sh)
For Each rngArea In rngIntersect.Areas
If rngArea.Cells.Count = 1 Then
vntItem = rngArea.Value
blnExist = (WorksheetFunction.CountIf(wks.Range(conDetectionRangeAddress), vntItem) > lngCount)
Else
For Each vntItem In rngArea.Value
blnExist = (WorksheetFunction.CountIf(wks.Range(conDetectionRangeAddress), vntItem) > lngCount)
If blnExist Then: Exit For
Next
End If
If blnExist Then Exit For
Next
If blnExist Then Exit For
Next
If blnExist Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "Lfd. Nr. " & vntItem & " ist bereits in " & wks.Name & vbNewLine & "in Zelle " & wks.Range(conDetectionRangeAddress).Find(vntItem, , xlValues).Address(0, 0) & " vorhanden!", _
vbExclamation, "A C H T U N G"
End If
End If
End With
Set wks = Nothing
Set rngArea = Nothing
Set rngIntersect = Nothing
End SubAnzeige