Beiträge zum Thread: Methode Range für Worksheet fehlgeschlagen

Hallo Christian,

das passiert, weil du weitere Events, welche so logischerweise passieren nicht ausschaltest.

nur dieses Problem behandelt so:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim ws As Worksheet

    Dim vA As Variant, vB As Variant, vC As Variant, vE As Variant

    Dim Satz As String, JahrText As String, RolleText As String

    Dim Farbe As Long

    

    Set ws = Me



    If Target.CountLarge > 1 Then Exit Sub

    On Error GoTo EventEinschalten

    ' -----------------------------

    ' FORMATIERUNG FÜR C, E, F, G, H (OHNE BOLD)

    ' -----------------------------

    If Not Intersect(Target, ws.Range("C:C,E:E,F:F,G:G,H:H")) Is Nothing Then

        Application.EnableEvents = False

        Farbe = ws.Cells(Target.Row, "A").Font.Color



        ' Hyperlink löschen in C und E

        If Target.Column = 3 Or Target.Column = 5 Then

            On Error Resume Next

            Dim hl As Hyperlink

            For Each hl In Target.Hyperlinks

                hl.Delete

            Next hl

            On Error GoTo 0

        End If



        With Target

            .Font.Bold = False

            .Font.Italic = True

            .Font.Name = "Calibri"

            .Font.Size = 11

            .HorizontalAlignment = xlCenter

            .Font.Color = Farbe

        End With



        If Target.Column = 7 Then Target.NumberFormat = "dd.mm.yyyy"

        If Target.Column = 8 Then Target.NumberFormat = "0%"

    End If   ' ? **dieses End If war vorher ohne If!**



    ' -----------------------------

    ' SATZBILDUNG BEI EINGABE IN SPALTE E

    ' -----------------------------

    If Target.Column = 5 Then

            

        vA = ws.Cells(Target.Row, "A").Value

        vB = ws.Cells(Target.Row, "B").Value

        vC = ws.Cells(Target.Row, "C").Value

        vE = Target.Value

    

        ' =========================

        ' JAHRLOGIK FÜR SPALTE C

        ' =========================

        If Trim(vC) = "" Then

            JahrText = ""

    

        ' endet auf "-" ? von  bis heute

        ElseIf Right(Trim(vC), 1) = "-" Then

            JahrText = " von " & Left(Trim(vC), Len(Trim(vC)) - 1) & " bis heute"

    

        ' Bereich wie 1999-2005

        ElseIf InStr(vC, "-") > 0 Then

            JahrText = " aus den Jahren " & vC

    

        ' einzelnes Jahr

        Else

            JahrText = " aus dem Jahr " & vC

        End If

    

    

        ' =========================

        ' ROLLENLOGIK FÜR SPALTE E

        ' =========================

        Select Case LCase(Trim(vE))

            Case "self", "herself"

                RolleText = " sich selbst"

            Case ""

                RolleText = ""

            Case Else

                RolleText = " die Rolle der " & vE

        End Select

    

    

        ' =========================

        ' FRAGE GENERIEREN

        ' =========================

        Satz = "Wann wurde die Schauspielerin " & vA & _

               " geboren, die im Film " & vB & JahrText & RolleText & " gespielt hat?"

    

        With ws.Cells(Target.Row, "F")

            .Value = Satz

            .Font.Bold = False

            .Font.Italic = True

            .Font.Name = "Calibri"

            .Font.Size = 11

            .HorizontalAlignment = xlCenter

            .Font.Color = ws.Cells(Target.Row, "A").Font.Color

        End With

    End If



    ' -----------------------------

    ' RANKING BEI EINGABE IN SPALTE G

    ' -----------------------------

    If Target.Column = 7 Then

        

        BerechneCodesRanking ws



        Dim Farbe2 As Long

        Farbe2 = ws.Cells(Target.Row, "A").Font.Color



        With ws.Cells(Target.Row, "G")

            .Font.Bold = False

            .Font.Italic = True

            .Font.Name = "Calibri"

            .Font.Size = 11

            .HorizontalAlignment = xlCenter

            .Font.Color = Farbe2

            .NumberFormat = "dd.mm.yyyy"

        End With



        With ws.Cells(Target.Row, "H")

            .Font.Bold = False

            .Font.Italic = True

            .Font.Name = "Calibri"

            .Font.Size = 11

            .HorizontalAlignment = xlCenter

            .Font.Color = Farbe2

            .NumberFormat = "0%"

        End With

    End If

    Application.EnableEvents = True

Exit Sub

EventEinschalten:

    Application.EnableEvents = True

End Sub

Gruß Uwe

Hallo Uwe,

erstmal vielen Dank. Dein Vorschlag funktioniert, aber wie meine Tests ergeben haben, reicht es auch, die Events zu Beginn aus und zum Schluss wieder einzuschalten... gibt es einen besonderen Grund, weshalb du das Errorhandling eingebaut hast?

Gruß
Christian

Hallo Christian,

man kann sicherlich Vieles. Nur ob es sinnvoll ist, ist eben eine andere Sache.

Mal abgesehen, dass man die Prozeduren grundsätzlich deutlich kompakter und effizienter bauen kann, würde ich dir nachdem du nicht mal bemerkt hast warum es zum Fehler kommt dir raten .EnableEvents einfach da zu belassen wo ich diese hingeschrieben habe.
Einer der Gründe:

If Target.CountLarge > 1 Then Exit Sub

Warum On Error: Um sicherzustellen, dass die Eventaktion wieder eingeschaltet wird, wenn aus welchen Grunde auch immer es zu einem Fehlerlauf kommt.

Noch ein letzter Hinweis: Schreibe in die erste Zeile ins Modul: Option Explicit zumindest über dem Zeitraum des Erlernens von VBA. Dies zwingt dich einerseits zum sauberen deklarieren und andererseits hilft es versteckte Fehler aufzufinden.

Gruß Uwe