防止潜水器运行

Question

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

但现在我有一些其他的子也会更改单元格（在主工作表中），但在这种情况下，我不需要（也不希望）VBA检查单元格，并在每次单元格更改后根据其值调整颜色。（编辑大量单元格时很烦人）。

（我已经试着把这个sub放在VBA的"ThisWorkbook"部分，而不是Sheet1（MainSheet）部分，但不幸的是，这没有任何区别）。

问题一：有可能防止这种情况发生吗

我还有一个与另一个子问题相关的问题，我认为在同一个问题中值得一提：在这个子中，创建了一个新的工作表，命名并填充了.txt文档中的文本。然后，该工作表将另存为新工作簿，并将删除该工作表。（图纸的名称与保存时的名称相同，并且每次出现时都会有所不同。）当我把.txt行一行一行地复制到这张工作表中时，我提到的第一个子（编辑单元格颜色的那个）就会被调用。在这个sub中发生的第一件事就是调用我的MainSheet。精简子任务完成后，行复制子任务将继续，但将开始在我的主工作表中粘贴行。我试图在这个子中输入行来选择具有变量名称的工作表，但它一直跳到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，因为我使用了对该工作表上单元格的直接引用。

请参阅如何避免在Excel VBA宏中使用"选择"，了解有关摆脱依赖选择和激活来实现目标的更多方法。