Excel 在 Worksheet_Change 上崩溃，但不在 Worksheet_SelectionChange 上

Question

我有一个电子表格，它是一种数据输入工具，用于从工程图纸中提取设备标签和行号——它设置有一个表格，其中包含 3 段标签（A-C 列）、5 段线号（A-E 列) 或完整标签列表（F 列），G 列连接标签段或拉过完整标签。我使用公式进行了此设置，但我宁愿避免在任何其他人将要使用的任何东西中使用复杂的公式，因此我尝试将公式转换为 VBA 并放入 Worksheet_Change 程序。

代码运行良好...直到您更改表格最后一行的单元格，然后按 Enter 键或使用向下箭头键，此时 Excel 崩溃。侧向或向上移动都可以，在按 Enter 之前从更改的单元格侧向移动也是如此。我尝试将表格转换为常规范围，但它仍然在数据的最后一行崩溃。我尝试将 Application.EnableEvents 设置为 False，这样就停止了崩溃，但随后更新不再正确触发。

如果过程更改为Worksheet_SelectionChange，它不会崩溃。

只是为了让它更有趣，在 Worksheet_Change 和 Worksheet_SelectionChange 过程中，使用向上/向下箭头键或回车键无法触发更改，但是在 Worksheet_SelectionChange 过程中向下/向上箭头返回到我刚刚移动的行会触发更新。

我确信有上百万种方法可以解决这个问题，但我不知道该怎么做，也没有找到答案。

我想要是让代码在活动单元格更改时更新列 G - 无论我是使用 Enter 键、Tab 键、箭头键还是 $!#@ 鼠标更改我的单元格选择。

我在使用 Excel 2016 的 Windows 10 机器上工作。明天上班时，我会看看它在 Excel 2013 上的运行情况。

电子表格截屏，供参考：https://drive.google.com/file/d/0B_wa8YmM1J2ddjlkOWxERE5TM1k/view?usp=sharing

我们将不胜感激任何帮助 - 特别是如果它附带对这里发生的事情的全面解释。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim strDelim As String
    Dim strConcatTag As String
    Dim intActiveRow As Integer

    Dim rngTagSegment As Range
    Dim rngSingleTag As Range
    Dim rng3SegmentTag As Range
    Dim rng5SegmentTag As Range
    Dim rngTagEntry As Range
    Dim rngConcatTag As Range
    Dim rngCheck As Range

    strDelim = "-"
    intActiveRow = ActiveCell.Row

    Set rngSingleTag = Cells(intActiveRow, 6)
    Set rng3SegmentTag = Range(Cells(intActiveRow, 1), Cells(intActiveRow, 3))
    Set rng5SegmentTag = Range(Cells(intActiveRow, 1), Cells(intActiveRow, 5))
    Set rngTagEntry = Range(Cells(intActiveRow, 1), Cells(intActiveRow, 6))
    Set rngConcatTag = Cells(intActiveRow, 7)

    If intActiveRow = 1 Then
        Exit Sub
        Else
            Select Case True
                Case WorksheetFunction.CountA(rngTagEntry) = 0
                        rngConcatTag = ""
                Case WorksheetFunction.CountA(rng5SegmentTag) > 0 And WorksheetFunction.CountA(rngSingleTag) > 0
                        rngConcatTag = "Enter either a complete tag or the individual sections, not both"
                Case WorksheetFunction.CountA(rng5SegmentTag) = 0 And WorksheetFunction.CountA(rngSingleTag) <> 0
                        rngConcatTag = UCase(Trim(rngSingleTag))
                Case WorksheetFunction.CountA(rng3SegmentTag) = 3 And WorksheetFunction.CountA(rng5SegmentTag) = 3
                        For Each rngTagSegment In rng5SegmentTag
                            strConcatTag = IIf(rngTagSegment = "", Trim(strConcatTag) & "", IIf(strConcatTag = "", _
                            Trim(rngTagSegment.Text), Trim(strConcatTag) & strDelim & Trim(rngTagSegment.Text)))
                        Next
                        rngConcatTag = UCase(Trim(strConcatTag))
                Case WorksheetFunction.CountA(rng3SegmentTag) = 3 And WorksheetFunction.CountA(rng5SegmentTag) = 5
                        For Each rngTagSegment In rng5SegmentTag
                            strConcatTag = IIf(rngTagSegment = "", Trim(strConcatTag) & "", IIf(strConcatTag = "", _
                            Trim(rngTagSegment.Text), Trim(strConcatTag) & strDelim & Trim(rngTagSegment.Text)))
                        Next
                        rngConcatTag = UCase(strConcatTag)
                Case Else
                    rngConcatTag = "Incomplete Tag"
            End Select
    End If
End Sub

Answer 1

这样的事情应该可以工作：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rw As Range, r As Range, dataRange As Range
    Dim rngSingleTag As Range
    Dim rng3SegmentTag As Range
    Dim rng5SegmentTag As Range
    Dim rngTagEntry As Range
    Dim rngConcatTag As Range


    'data entry area only (adjust to suit)...
    Set dataRange = Application.Intersect(Target, Me.Range("A2:F10000"))

    If dataRange Is Nothing Then Exit Sub 'nothing to do...

    'process each changed row
    For Each r In dataRange.Rows

        Set rw = r.EntireRow

        Set rngSingleTag = rw.Cells(6)
        Set rng3SegmentTag = rw.Cells(1).Resize(1, 3)
        Set rng5SegmentTag = rw.Cells(1).Resize(1, 5)
        Set rngTagEntry = rw.Cells(1).Resize(1, 6)
        Set rngConcatTag = rw.Cells(7)

        Select Case True
            Case filled(rngTagEntry) = 0
                    rngConcatTag = ""
            Case filled(rng5SegmentTag) > 0 And filled(rngSingleTag) = 1
                    rngConcatTag = "Enter either a complete tag or the individual sections, not both"
            Case filled(rng5SegmentTag) = 0 And filled(rngSingleTag) = 1
                    rngConcatTag = UCase(Trim(rngSingleTag))
            Case filled(rng3SegmentTag) = 3 And filled(rng5SegmentTag) = 3
                    rngConcatTag = Tag(rng3SegmentTag)
            Case filled(rng5SegmentTag) = 5
                    rngConcatTag = Tag(rng5SegmentTag)
            Case Else
                rngConcatTag = "Incomplete Tag"
        End Select

    Next r

End Sub

Function filled(rng)
    filled = Application.CountA(rng)
End Function

Function Tag(rng) As String
    Const DELIM As String = "-"
    Dim c As Range, rv As String
    For Each c In rng.Cells
        rv = rv & IIf(Len(rv) > 0, DELIM, "") & Trim(c.Text)
    Next c
    Tag = rv
End Function