防止子运行

Question

在 sheet1（我称之为“MainSheet”）中，我的 VBA 脚本中有一个子组件，当此工作表中的单元格发生更改时，它会检查某些单元格的值。 （更改单元格时将发生的主要操作之一是修改其颜色，绿色表示单​​元格的值，红色表示空单元格）

但是现在我有一些其他子也可以更改单元格（在主表中），但在这种情况下，我不需要（也不希望）VBA 检查单元格并将颜色调整为它们的值每次细胞变化后。 （编辑大量单元格时很烦人）。

（我已经尝试将此子放在 VBA 的“ThisWorkbook”部分而不是 Sheet1(MainSheet) 部分，但不幸的是这根本没有区别）。

问题一：是否可以防止这种情况发生？

我还有一个与另一个子相关的问题，我认为在同一个问题中值得一提：在这个子中创建了一个新工作表，命名并填充了 .txt 文档中的文本。然后工作表将保存为新工作簿，工作表将被删除。 （工作表的名称等于保存时将获得的名称，并且随着新的出现而变化。） 当我将 .txt 行逐个复制到此工作表中时，会调用我提到的第一个子项（一个编辑单元格颜色）。在这个 sub 中发生的第一件事就是调用我的 MainSheet。当薄子完成后，行复制子将继续，但将开始在我的主表中粘贴行。我试图在这个 sub 中输入行来选择具有变量名称的工作表，但它一直跳到 MainSheet。

问题二：如何防止跳转到 MainSheet？

（这两个问题可能有相同的解决方案。）

修改单元格颜色的子：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Integer
'Collor all cells green containing values, collor empty cells red.
''Starts automaticly after every cell change within this sheet
'Huidige Cell onthouden

If Not Intersect(Target, Range("A9:A29")) Is Nothing Then
        On Error GoTo bm_Safe_Exit3
        Application.EnableEvents = False
        If Intersect(Target, Range("A9:A29")).Cells.Count > 1 Then
            Application.Undo
            MsgBox "Please edit one cell at a time!"
        Else
            Dim newVal3 As Variant

            newVal3 = Target.Value
            Range("A9:A29").ClearContents
            Target.Value = newVal3
        End If
End If

bm_Safe_Exit3:
    Application.EnableEvents = True


Set myActiveCell = ActiveCell
Set myActiveWorksheet = ActiveSheet
Set myActiveWorkbook = ActiveWorkbook

Sheets("MainSheet").Select
Range("C5").Select
j = 0

Do While j < 6
    If ActiveCell.Offset(0, j).Value = "" Then
        ActiveCell.Offset(-1, j).Interior.Color = RGB(255, 0, 0)
            Else: ActiveCell.Offset(-1, j).Interior.Color = RGB(0, 255, 0)
    End If
    j = j + 1
Loop

'Terug naar de voormalig active cell
    myActiveWorkbook.Activate
    myActiveWorksheet.Activate
    myActiveCell.Activate

End Sub

Answer 1

使用.Select 和.Activate 在最好的时候效率很低；在Worksheet_Change 事件宏中，它真的会弄脏水。

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo bm_Safe_Exit
    Application.EnableEvents = False

    If Not Intersect(Target, Range("A9:A29")) Is Nothing Then
        If Intersect(Target, Range("A9:A29")).Cells.Count > 1 Then
            Application.Undo
            MsgBox "Please edit one cell at a time!"
            'intentionally throw an error; no more code run; sent to bm_Safe_Exit
            Err.Raise 0
        Else
            Dim newVal3 As Variant
            newVal3 = Intersect(Target, Range("A9:A29")).Cells(1).Value
            Range("A9:A29").ClearContents
            Intersect(Target, Range("A9:A29")).Cells(1) = newVal3
        End If
    End If

    Dim j As Integer
    With Worksheets("MainSheet").Range("C5")
        For j = 0 To 6
            If Not CBool(Len(.Offset(0, j).Value)) Then
                .Offset(-1, j).Interior.Color = RGB(255, 0, 0)
            Else
                .Offset(-1, j).Interior.Color = RGB(0, 255, 0)
            End If
        Next j
    End With

bm_Safe_Exit:
    Application.EnableEvents = True

End Sub

目前尚不清楚这是在哪个工作表下运行的；我希望它不是 MainSheet，因为我直接引用了该工作表上的单元格。

请参阅How to avoid using Select in Excel VBA macros，了解更多摆脱依赖选择和激活来实现目标的方法。