Thema: Worksheet_Change mehrere Zellen gleichzeitig

Hallo zusammen,
ich habe eine Tabelle A3:W300 mit verschiedenen Daten. Wenn ich in Spalte W in der zu löschenden Zeile ein x schreibe, werden alle Einträge aus der (Target.Row) Zeile gelöscht.

    If Target.Column = 23 Then 'Spalte W            ' Ein X in die zu löschende Zeile eintragen

        thisrowdelete = Target.Row

        

        On Error Resume Next

        

        If Target.Value = "x" Then

            Range("B" & thisrowdelete).ClearContents

            Range("E" & thisrowdelete).ClearContents

            Range("H" & thisrowdelete).ClearContents

            Range("F" & thisrowdelete).ClearContents

            Range("L" & thisrowdelete).ClearContents

            Range("O" & thisrowdelete).ClearContents

            Range("Q" & thisrowdelete).ClearContents

            Range("W" & thisrowdelete).ClearContents

            ActiveSheet.Calculate

        End If

    End If

Wenn ich mit folgendem Makro gleichzeitig mehrere selektierte Zellen mit einem x versehe, funktioniert das natürlich nicht.

Sub Zellenauffüllen()



' Text in die zuvor markierten Zellen eintragen.



Dim StrText As String



StrText = ""

StrText = Application.InputBox(prompt:="Welcher Wert soll eingefügt werden?", Title:="--=[xXx]=--", _

Default:="Wert", Type:=2)



If StrText = "Falsch" Then

    Exit Sub

End If



Selection = StrText ' Was hier eingetragen ist, wird in die markierten Zellen geschrieben!



End Sub

Ich habe es mit einer for each Schleife versucht, aber da komme ich nicht weiter. Ich schätze, dass es grundsätzlich mit Worksheet_Change gar nicht geht.
Grüße
Wallace

Hallo


- mehrere Zellen mit x versehen, dann per Schleife
- zusätzlich noch das Einzellöschen in einem Rutsch erledigen

- Rekursionsaufruf ausgeschaltet
- dafür Fehlerbehandlung sinnvoll

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Zelle As Range, RNG As Range

    

    On Error GoTo Fehler

    Const APPNAME = "Worksheet_Change"

    If Target.Column = 23 Then 'Spalte W            ' Ein X in die zu löschende Zeile eintragen

        Set RNG = Range("B:B,E:E,H:H,L:L,F:F,O:O,Q:Q,W:W")



        For Each Zelle In Target

            If Zelle.Value = "x" Then

                Application.EnableEvents = False

                Intersect(RNG, Rows(Zelle.Row)).ClearContents

            End If

        Next

        

        ActiveSheet.Calculate

    End If

    

    '*** Fehlerbehandlung

    Err.Clear

Fehler:

    Application.EnableEvents = True

    If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _

        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear

End Sub

LG UweD

Perfekt, UweD, das macht genau das was es soll!
Ich versteh zwar nicht, wieso *LOL* aber das krieg ich sicher noch raus.
Danke, kann geschlossen werden.
Grüße
Wallace

Nur als Tipp zum Verständnis

Intersect (SPALTEN, Zeile)

Damit ist die Schnittmenge aus Spalten und der Zeile gemeint ...


LG UweD