Excel VBA工作表更改崩溃

huangapple go评论59阅读模式
英文:

Excel VBA Worksheet change crashes

问题

I tried running a worksheet change macro and it seems that when I had an error (due to data validation from a list) in one of the cells and then clicked somewhere else in the sheet, then the excel crashes.

This sheet has worksheet change macros and I assume that due to this, it keeps on crashing. Can someone help? Thanks.

VBA code omitted

英文:

I tried running a worksheet change macro and it seems that when I had an error (due to data validation from a list) in one of the cells and then clicked somewhere else in the sheet, then the excel crashes.

This sheet has worksheet change macros and I assume that due to this, it keeps on crashing. Can someone help? Thanks.

   
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






答案1

得分: 3

In case you get an Out of Stack space error when using a worksheet event, you have to turn off the event handler, i.e., you add Application.EnableEvents = False at the beginning. And, of course, you should turn it on again at the end of your code.

If you do not turn off the event handler, the worksheet_change event will be called again and again because you change values in the worksheet. And this will happen as long as stack space is available.

I usually code it like this:

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
英文:

In case you get an Out of Stack space error when using a worksheet event you have to turn off the event handler i.e. you add Application.EnableEvents = False at the beginning. And, of course, you should turn it on again at the end youf your code.

If you do not turn off the event handler, the worksheet_change event will be called again and again because you change values in the worksheet. And this will happen as along as stack space is available

I usually code it like that

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

huangapple
  • 本文由 发表于 2023年5月13日 14:16:06
  • 转载请务必保留本文链接:https://go.coder-hub.com/76241357.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定