Target Address multiple Zelle
18.01.2022 19:20:08
CoAdmiral
es soll geprüft werden, wenn Bereich A oder Bereich B Änderungen erhalten, das dann jeweils X oder Y durchgeführt wird. Mein Problem: der Bereich B wird nicht geprüft.
Option Explicit
Public strRGNR As String
Public lngMax As Long
Public arrLogStart As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i As Long
Dim strNextFree As String
Dim strCheck As String
Dim arrLogstr() As Variant
Dim rng As Range
Dim lngMaxNr As String
Dim intString, x As Integer
Dim wsRG, wsLog As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set wsRG = wb.Worksheets("RG-Nr")
Set wsLog = wb.Worksheets("Log")
On Error GoTo ErrorHandler
Application.EnableEvents = False
Set rng = ThisWorkbook.Worksheets("Log").Range("RG_Array") 'erfasse alle bisher vergebenen RG-Nr
arrLogstr = rng
' nicht relevanter Code, nur hier der Vollständigkeit
ReDim arrLogLng(1 To UBound(arrLogstr, 1), 1) As Long
For i = LBound(arrLogstr, 1) To UBound(arrLogstr, 1)
arrLogLng(i, 1) = arrLogstr(i, 1)
Next i
lngMax = WorksheetFunction.Max(arrLogLng, 1) 'ermittel die nächste freie RG; Lücken werden hierbei übersprungen
lngMax = lngMax + 1
strNextFree = "'" & Format(lngMax, "00000")
strCheck = Worksheets("RG-Nr").Range("RGNR").Value
'Ende unrelevanter Code
If Not Intersect(Target, wsRG.Range("RGNR")) Is Nothing Then 'Bereich A
'Prüft ob Nummern im Feld "RGNR" gültigen Format eingegeben werden
If Len(Target) 5 Or IsNumeric(Target) = False Then
'Nutzer informiere was falsch lief
GoTo ErrorHandler
End If
'wenn eingegebenes Format korrekt war, prüf ob die Nummer frei ist
For i = LBound(arrLogstr, 1) To UBound(arrLogstr, 1)
'Nr frei? --> ja/nein
Next i
'------------wenn Kommentar entfernt wird, wird angenommen, die RG-Nr wurde nun verwendet
ElseIf Not Intersect(Target, wsLog.Range("D:D")) Is Nothing Then 'Bereich B
MsgBox Target.Address
End If
ErrorHandler:
Application.EnableEvents = True
End Sub
"RGNR" ist eine einzelne Zelle. Ist Target nicht "RGNR", so springt der Code immer direkt auf
Application.EnableEvents = True