VBA fehler beim inhalt löschen

[ecvBxter]

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Shapes("Kontrollkästchen 3").OLEFormat.Object.Value = 1 Then
If Intersect(Target, Range("F5:F16")) Is Nothing Then Exit Sub
If Target.Value <> "" Then
Target.Offset(0, 1).Value = Date
Else
Target.Offset(0, 1).ClearContents
End If
End If
End Sub

Wenn ich die Werte D-H markiere und inhalt löschen auswähle bekomme ich immer eine Fehlermeldung


Laufzeitfehler `13´:
Typen unverträglich


unter debug ist dies gelb markiert
If Target.Value <> "" Then
lässt sich das irgendwie korrigieren?

[26865]

Wie der Fehler entsteht, dürfte klar sein: Ein Datenfeld kann man nicht auf Gleichheit mit einem String prüfen, sondern nur jedes einzelne Element.

Damit hast du dann deine Lösung: 

Code:

Dim c as Range
For Each c in Intersect(…)
   If Isempty(c) Then
usw.

[ecvBxter]

Wenn ich bei D1, E1 und F1 was eingebe soll bei G1 das Datum von heute eingetragen werden entscheidend ist F1.
Markiere ich nun D1+E1+F1 und löschen den Inhalt kommt es zu diesem Fehler, wenn ich alles einzeln löschen dann klappt das ohne die Fehlermeldung.

[26865]

Schau bitte nochmal in meine andere Antwort, da stehen die Erklärung und die Lösung.

[ecvBxter]

So ?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Shapes("Kontrollkästchen 3").OLEFormat.Object.Value = 1 Then
If Intersect(Target, Range("F5:F16")) Is Nothing Then Exit Sub
Dim c As Range
For Each c In Intersect(…)
  If IsEmpty(c) Then
Target.Offset(0, 1).Value = Date
Else
Target.Offset(0, 1).ClearContents
End If
End If
End Sub

mit dem Kontrollkästchen 3 kann ich den script de/-aktivieren

[26865]

So ?

Nein. Schau nochmal genau hin.

Willst du die Prozedur denn deaktivieren, wenn du löscht, oder warum erwähnst du das?

---

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Shapes("Kontrollkästchen 3").OLEFormat.Object.Value = 1 Then
    If Intersect(Target, Range("F5:F16")) Is Nothing Then Exit Sub
    Dim c As Range
   
    Application.EnableEvents = False
    For Each c In Intersect(Target, Range("F5:F16"))
        If Not IsEmpty(c) Then
            c.Offset(0, 1).Value = Date
        Else
            c.Offset(0, 1).ClearContents
        End If
    Next c
    Application.EnableEvents = True
End If
End Sub

[ecvBxter]

nein das soll optional sein für mich sind das alles böhmische dörfer ich verstehe davon sogut wie nichts


Ok habs hinbekommen Vielen dank, das ist ja blöd das man den Code scrollen muss hate deswegen nur die hälfte kopiert

---

Edit:

funktioniert soweit gut bis aufs Kontrollkästchen 3 dem Code ist es egal es lässt sich nicht ausshalten.