AW: Fehler bei RNG4 kann ich nicht lösen
25.12.2022 16:56:14
Nepumuk
Hallo Ralf,
so:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TB As Worksheet, Kunu, Datum, Zeit, Zeile As Long
Dim SpK As Integer, SpD As Integer, SpR As Integer, SpG As Integer, SpL As Integer
Dim RNG1 As Range, RNG2 As Range, RNG3 As Range, RNG4 As Range, Zelle As Range
'On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
Set TB = Sheets("Kundendatenbank")
SpK = 4 'Spalte der Kundennummer =D
SpD = 14 'Spalte mit Datum =N
SpR = 8 'Spalte mit Restdaten =H
SpL = 44 'Spalte für Kommentare = 44
Set RNG1 = Range("B25:G25") 'Restdaten
Set RNG2 = Range("e26,e27") 'Datum Uhrzeit
Set RNG4 = Range("O10")
'nur bei Änderungen in diesen Zellen auslösen
If Not Intersect(Union(RNG1, RNG2, RNG4), Target) Is Nothing Then
Kunu = Range("B3")
If WorksheetFunction.CountIf(TB.Columns(SpK), Kunu) > 0 Then
'Kunde bereits vorhanden?
Zeile = WorksheetFunction.Match(Kunu, TB.Columns(SpK), 0)
Else
'Kunde nicht vorhanden?
MsgBox "Kundennummer nicht gefunden"
Exit Sub
End If
If Not Intersect(RNG1, Target) Is Nothing Then
'Restdaten eintragen
TB.Cells(Zeile, SpR).Offset(0, Target.Column - 2) = Target
End If
If Not Intersect(RNG2, Target) Is Nothing Then
Datum = Range("e26")
Zeit = Range("e27")
'Datum / Zeit; Beides muss eingetragen sein
If IsDate(Datum) And IsNumeric(Zeit) And Zeit 0 Then
'Zeit und Datum eintragen
TB.Cells(Zeile, SpD) = Datum
TB.Cells(Zeile, SpD + 1) = Format(Zeit, "hh:mm")
Application.EnableEvents = False
'KD Nr. Matchcode eintragen
Range("B3").FormulaR1C1 = "=R1C1" 'als Formel
Range("D3").FormulaR1C1 = "=R1C2"
'reset
RNG1 = "": RNG2 = "": RNG4 = ""
Application.EnableEvents = True
End If
End If
End If
'*** Fehlerbehandlung
Err.Clear
If Target.Address = "$J$20" Or _
Target.Address = "$J$20:$N$21" Then 'hier beginnt mein Code
Dim lloUnknown As Long
Dim lloLastRow As Long, liCol As Integer
Dim larKnown() As Variant, liIdx As Integer
Dim larFound() As Variant, liIdxFound As Integer
ReDim larFound(1, 0)
Application.EnableEvents = False
Sheets("Kundenmaske").Range("J22:L27").Value = "" 'die Liste mit zuvor gefundenen Telefonnummern wird gelöscht
If Sheets("Kundenmaske").Range("J20").Value = "" Then 'wenn Eintrag in J20 nur gelöscht wird, dann wird der Code abgebrochen
Application.EnableEvents = True
Exit Sub
End If
If Len(Sheets("Kundenmaske").Range("J20").Value)
Gruß
Nepumuk