Excel VBA工作表更改崩溃

我试着运行一个工作表更改宏，似乎当我在其中一个单元格中出现错误（由于列表中的数据验证），然后单击工作表中的其他地方时，Excel崩溃了。
这个工作表有工作表更改宏，我假设由于这个，它不断崩溃。有人能帮忙吗谢谢。

Option Explicit
Dim Monitored


'Private Sub Worksheet_Activate()
    'Monitored = Sheet1.Range("C110").Value 'Read in value prior to any changes
'End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Dim KeyCells As Range
Dim KeyCells2 As Range
'Regelmäßigkeit
Set KeyCells = Sheet1.Range("A1:M157")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

If Sheet1.Range("L38").Value = "Nein" Then
    Sheet1.Rows("42:44").Hidden = True
   
ElseIf Sheet1.Range("L38").Value = "Ja" Then
    Sheet1.Rows("42:44").Hidden = False
    
End If

'Keine extra Frage
If Sheet1.Range("C99").Value = "17. Bitte beachten Sie folgende Besonderheiten:" Then
    Sheet1.Rows("98:103").Hidden = True
'Extra Frage
ElseIf Sheet1.Range("C99").Value <> "17. Bitte beachten Sie folgende Besonderheiten:" Then
    Sheet1.Rows("98:103").Hidden = False

End If

Dim lastRow As Long
Dim sumX As Long
Dim result As String
Dim sumXY As Long

'Keine Extra Frage
If Sheet1.Rows("98:103").Hidden = True Then

'Unvollständig
If Application.WorksheetFunction.CountIf(Sheet1.Range("P1:P97"), "X") > 0 Then
    Sheet1.Range("C106").Value = Sheet2.Range("A53").Value
ElseIf Application.WorksheetFunction.CountIf(Sheet1.Range("P1:P97"), "X") = 0 Then

        'Check if the value in E25 is in Sheet2 column G
        If Application.WorksheetFunction.CountIf(Sheet2.Range("H3:H229"), Sheet1.Range("E25").Value) > 0 Then
            'If the value is found, sum the values in O1:O98
            sumX = Application.WorksheetFunction.CountIf(Sheet1.Range("O1:O97"), "X")

            If sumX = 16 Then
                'Wenn Summe gleich 16 ist, dann genehmigt
                Sheet1.Range("C106").Value = Sheet2.Range("A33").Value
            ElseIf sumX < 16 Then
                'Wenn Summe ungleich 16 ist, dann mit Vorbehalt
                Sheet1.Range("C106").Value = Sheet2.Range("A43").Value
            End If
        Else
                Sheet1.Range("C106").Value = Sheet2.Range("A43").Value
        End If
End If

'Extra Frage
ElseIf Sheet1.Rows("98:103").Hidden = False Then

'Unvollständig
If Application.WorksheetFunction.CountIf(Sheet1.Range("P1:P99"), "X") > 0 Then
    Sheet1.Range("C106").Value = Sheet2.Range("A53").Value

ElseIf Application.WorksheetFunction.CountIf(Sheet1.Range("P1:P99"), "X") = 0 Then

        'Check if the value in E25 is in Sheet2 column G
        If Application.WorksheetFunction.CountIf(Sheet2.Range("H3:H229"), Sheet1.Range("E25").Value) > 0 Then
            'If the value is found, sum the values in O1:O98
            sumX = Application.WorksheetFunction.CountIf(Sheet1.Range("O1:O99"), "X")
    
            If sumX = 17 Then
                'Wenn Summe gleich 17 ist, dann genehmigt
                Sheet1.Range("C106").Value = Sheet2.Range("A33").Value
            ElseIf sumX < 17 Then
                'Wenn Summe ungleich 17 ist, dann mit Vorbehalt
                Sheet1.Range("C106").Value = Sheet2.Range("A43").Value
            End If
        Else
                Sheet1.Range("C106").Value = Sheet2.Range("A43").Value

        End If
End If
End If

'Colour coding
If Sheet1.Range("C106").Value = Sheet2.Range("A33").Value Then
Sheet1.Range("C106").Interior.ColorIndex = 43
ElseIf Sheet1.Range("C106").Value = Sheet2.Range("A43").Value Then
Sheet1.Range("C106").Interior.ColorIndex = 44
ElseIf Sheet1.Range("C106").Value = Sheet2.Range("A53").Value Then
Sheet1.Range("C106").Interior.ColorIndex = 46
End If

End If

End Sub

如果你在使用worksheet event时得到Out of Stack space错误，你必须关闭 * 事件处理程序 *，即。你在开头加上Application.EnableEvents = False。当然，你应该在代码的最后再次打开它。
如果不关闭 * 事件处理程序 *，worksheet_change事件将被反复调用，因为您更改了工作表中的值。沿着堆栈空间可用，就会发生这种情况
我通常都是这样编码的

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo EH
    Application.EnableEvents = False

    ' code which should run
EH:
    ' just to make sure that Events get triggered again
    ' even in case there is an error in the previous code
    Application.EnableEvents = True
    
End Sub

Excel VBA工作表更改崩溃

1条答案

相关问题

热门标签

最新问答