尝试在 Worksheet_Change 方法中执行此代码时出现无限循环并崩溃 [重复]

Question

因此，我开发了一种算法，该算法根据单词中字母出现的某些规则将单词分解为多个部分。我已经设法调试了整个算法，现在为了方便用户，我尝试将其放入 Worksheet_Change 方法中，如下所示：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arr() As String
    Dim i As Byte
    Dim j As Byte

    If (Target.Column = 1) Then
        If (Target.Value <> "") Then
            arr() = BreakupWord("perform")
            For i = 1 To 10
                Cells(Target.Row, i + 1) = arr(i)
            Next i
        ElseIf (Target.Value = "") Then
            For j = 1 To 10
                Cells(Target.Row, i + 1) = ""
            Next j
        End If
    End If
End Sub

基本上，变量 arr() 将单词“Target”的分解组件存储在其数组中，并通过 For 循环我尝试将内容打印到工作表上的单元格中 考虑到用户仅根据条件对工作表的 A 列进行了更改

现在，问题是这样的：我一行一行地测试了多个单词，代码运行流畅。但是，如果我转到 A 列 中已输入的单词并通过 Backspace 或 Delete 将其删除，我的代码似乎进入了一个无限循环并且 Excel 崩溃了。可能是什么问题，我该如何避免？

Answer 1

您需要在更改同一个工作表上的值之前关闭事件，否则您会触发另一个事件。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arr() As String
    Dim i As Byte
    Dim j As Byte

    If (Target.Column = 1) Then
        APPLICATION.ENABLEEVENTS = FALSE
        If (Target.Value <> "") Then
            arr() = BreakupWord("perform")
            For i = 1 To 10
                Cells(Target.Row, i + 1) = arr(i)
            Next i
        ElseIf (Target.Value = "") Then
            For j = 1 To 10
                Cells(Target.Row, i + 1) = ""    'should i be j?
            Next j
        End If
    End If
    APPLICATION.ENABLEEVENTS = TRUE
End Sub

您没有涵盖 Target 可能不止一个单元格的情况。

我不明白嵌套的 If ... ElseIf ... End If。它显示为 If not blank ElseIf blank.

BreakupWord 是否返回从 1 开始的数组？默认情况下，一维数组是从零开始的。

Answer 2

您已经被告知避免递归调用同一事件处理程序的相关问题

这是另一个代码：

• 管理该问题

• 添加错误捕获以防止任何错误使您禁用事件处理

• 检查适当的更改范围以进行操作（A 列中的一个单元格范围）

• 简化单元格书写

  Private Sub Worksheet_Change(ByVal Target As Range)
      Dim arr As Variant ' a Variant can handle arrays too
  
      With Target 'reference changed range
          If .Count = 1 Then ' if only one cell changed
              If .Column = 1 Then ' if changed cell in column "A"
                  On Error GoTo ExitSafely 'handle possible errors
                  Application.EnableEvents = False 'prevent subsequent sheet changing rise and infinite loop by calling recursively thsi very same sub
                  If .value <> "" Then
                      arr = BreakupWord("perform")
                      .Offset(, 1).Resize(, UBound(arr) - LBound(arr) + 1) = arr 'write next to changed cell into as many cells as array elements
                  Else
                      .Parent.Range(.Parent.Cells(.Row, .Parent.Cells.Columns.Count).End(xlToLeft), .Offset(, 1)).ClearContents 'clear the content of any cell right of changed one
  '                    .Offset(, 1).Resize(, 10).ClearContents ' clear 10 cells right of changed one
                  End If
              End If
          End If
      End With
  
  ExitSafely:
      Application.EnableEvents = True
  End Sub
  

只需确保您的 BreakupWord() 函数返回一个 Variant 数组，例如

Function BreakupWord(strng As String) As Variant
    '....
    BreakupWord = Array("1", "2", "3", "4")

    'in the end
    BreakupWord = Array("1", "2", "3", "4") ' or any other way to assign an array to BreakupWord 
End Function