Question

在sheet1中（我已经调用了＃34; MainSheet＆＃34;）我的VBA脚本中有一个子命令，只要在此工作表中更改了一个单元格，就会检查某些单元格的值。（当更改单元格时将发生的主要操作之一是修改它的颜色，对于具有值的单元格为绿色，对于空单元格为红色）

但是现在我还有其他一些也改变了细胞（在主页中），但在这种情况下，我不需要（也不想要）VBA检查细胞并在每次细胞更换后调整颜色值。（编辑大量单元格时很烦人。）

（我已经尝试将此sub放在＆＃34; ThisWorkbook＆＃34; VBA的一部分而不是Sheet1（MainSheet）部分，但不幸的是，这根本没有任何区别。

问题一：是否有可能阻止这种情况？

我还有一个与我认为在同一个问题中值得一提的另一个子问题的相关问题：在这个子目录中创建一个新工作表，命名并填充.txt文档中的文本。然后，工作表将保存为新工作簿，并将删除工作表。（工作表的名称等于它保存时将获得的名称，并且每次出现都会有所不同。）当我将.txt行逐个复制到此工作表中时，会调用我提到的第一个子（一个编辑单元格颜色）。这个子中发生的第一件事就是调用我的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 ，因为我使用了直接引用该工作表上的单元格。

有关远离依赖选择和激活以实现目标的更多方法，请参阅How to avoid using Select in Excel VBA macros。

防止sub运行

1 个答案: