AW: springt nicht aus A1 zurück
10.01.2022 20:29:43
Yal
Hallo Ralf,
anbei eine bereinigte Version von deinem Code. Viel weniger Verschachtelung, sprechende Variable, Variable, die keine Änderung bekommen als Konstante.
Einige Fehler sind noch drin, weil -na ja- Saustall eben. Aber so könntest Du mindestens eine bessere/leichtere Übersicht über das gesamt bekommen udn die Logik besser nachvollziehen.
Variabledeklaration "Option Explicit" ist für Anfänger PFLICHT ("Extras", "Optionen", "Variabledekaration erforderlich")
Option Explicit
Const SpKnd = 2 'Spalte der Kundennummer =B
Const SpGsp = 9 'Spalte mit Gespächsnotizen = I
Const SpKom = 13 'Spalte mit Kommentar = l
Const SpDat = 17 'Spalte mit Datum =l
Const SpUhr = 18 'Spalte mit Uhrzeit
Const rgKnd = "C4"
Const rgInf = "C11"
Const rgKom = "C12"
Const rgDat = "C13"
Const rgUhr = "C14"
Private ZielZeile As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Const APPNAME = "Worksheet_Change"
On Error GoTo Fehler
If Target.Cells.Count > 1 Then GoTo Finally 'Alle Behandlung NUR, wenn EINE Zelle (=per Hand) geändert wurde
Application.EnableEvents = False
'verursacht Fehler bei nicht vorhandene Kundennummer und springt daher auf Fehlerbehandlung
ZielZeile = WorksheetFunction.Match(Range(rgKnd).Value, Worksheets("Datenbank").Columns(SpKnd), False)
Select Case Target.Address(False, False)
Case rgKnd 'C4
Terminvorlage_leeren
Case rgInf 'C11
Info_ablegen ' Worksheets("Datenbank").Cells(Zeile, SpKom).Offset(0, Target.Column - 6) = Range(rgInf).Value 'Info eintragen
Notiz_ablegen
Case rgKom 'C12
'Restdaten eintragen
Kommentar_ablegen
Case rgDat 'C13
Datum_ablegen
Case rgUhr 'C14
Terminvorlage_leeren
Uhrzeit_ablegen
Case Else
End Select
GoTo Finally
Fehler:
Select Case Err.Number
Case 1004
MsgBox "Fehler bei der Suche nach Kunden """ & Range(rgKnd).Value & """.", vbExclamation, "Nicht vorhanden"
Case Else
MsgBox "Fehler in Sub """ & APPNAME & """" & vbCr _
& "Fehler: " & Err.Number & vbCr _
& "Descr.: " & Err.Description
End Select
Err.Clear
Finally:
Application.EnableEvents = True
End Sub
Private Sub Terminvorlage_leeren()
Worksheets("Terminvorlage").Range("leeren").ClearContents
End Sub
Private Sub Datum_ablegen()
If IsDate(Range(rgDat).Value) Then
Worksheets("Datenbank").Cells(ZielZeile, SpDat) = Format(Range(rgDat).Value, "DD.MM.YYYY") 'könnte auch in Datum_ablegen ausgelagert werden
End If
End Sub
Private Sub Uhrzeit_ablegen()
If Range(rgUhr).Value "" And IsDate(Range(rgUhr).Value) Then
Worksheets("Datenbank").Cells(ZielZeile, SpUhr) = Format(Range(rgUhr).Value, "hh:mm")
End If
End Sub
Private Sub Kommentar_ablegen()
Worksheets("Datenbank").Cells(ZielZeile, SpKom).Offset(0, Range(rgKom).colum - 2) = Range(rgKom).Value 'Kommentar eintragen
End Sub
Private Sub Info_ablegen()
Worksheets("Datenbank").Cells(ZielZeile, SpKom).Offset(0, Range(rgInf).Column - 6) = Range(rgInf).Value 'Info eintragen
End Sub
Private Sub Notiz_ablegen()
Dim Machen As Boolean
'Gesprächsnotizen eintragen/löschen
Machen = Range(rgKom) = ""
If Range(rgKom).Offset(0, 1).Text "" Then
Machen = MsgBox("Soll die vorhandene Notiz in der Zeile " & Zelle.Row & " überschrieben werden?", _
vbQuestion + vbYesNo, "Eintrag überschreiben") = vbYes
End If
If Machen Then Worksheets("Datenbank").Cells(ZielZeile, SpGsp).Offset(0, Range(rgKom).Row - 10) = Zelle.Text
End Sub
VG
Yal