Question

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

代码工作正常......直到您更改表格最后一行的单元格，然后按Enter或使用向下箭头键，此时Excel崩溃。向侧面或向上移动是很好的，因此在击中进入之前横向移动已经改变的单元格。我尝试将表转换为常规范围，但它仍然在数据的最后一行崩溃。我尝试将 Application.EnableEvents 转为False，然后停止崩溃，但更新不再能正常触发。

如果程序更改为 Worksheet_SelectionChange ，则不会崩溃。

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

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

我想要的代码是，只要活动单元格发生变化，代码就会更新G列 - 无论是否使用回车键，Tab键，箭头键或$！＃@鼠标来改变我的细胞选择。

我正在使用Excel 2016在Windows 10计算机上工作。当我明天开始工作时，我会看到Excel 2013的工作原理。

电子表格screencap，供参考：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

Excel在Worksheet_Change上崩溃，但不在Worksheet_SelectionChange

1 个答案: