首页 文章

Excel VBA:剪切/粘贴/删除/插入事件时触发宏

提问于
浏览
0

我有一个条件格式规则定义为宏,它删除旧规则并用更新规则替换它们:

Sub setCondFormat()
    Set Table = ActiveSheet.ListObjects("Rules")
    Table.Range.FormatConditions.Delete
    Set Attribute = Table.ListColumns("Attribute")
    With Attribute.DataBodyRange.FormatConditions _
    .Add(xlExpression, xlEqual, "=ISEMPTY(A2)")
        With .Interior
            .ColorIndex = 0
        End With
    End With
End Sub

Excel中的条件格式需要更新 . 否则规则中的单元格范围会变得碎片化 .

假设您有两条规则:

  • 使 $A$1:$A$30 变红

  • Make $B$1:$B$30 blue现在选择 A10:B10 并将其复制/粘贴到 A20:B20 .
    Excel将执行的操作是删除条件格式 .

对于应用于这些单元格的规则的 A20:B20 ,并添加具有 A20:B20 格式的新规则 . 你最终得到四条规则:

  • 使 =$A$20 红色

  • 使 =$B$20 蓝色

  • 使 =$A$1:$A$19,$A$21:$A$30 变红

  • 使 =$B$1:$B$19,$B$21:$B$30 蓝色

当表结构通过 cut/paste/delete/insert 事件更改时,会发生这种情况 .

如何在 cut/paste/delete/insert 事件上触发上述VBA宏?

2 回答

  • 0

    您可以使用宏的快捷方式

    VBA event trigger on copy?

    如果你不想这样,你需要使用Windows API:

    Is there any event that fires when keys are pressed when editing a cell?

  • 0

    我找到的解决方案是在打开工作簿时创建一个包含表格内容的新工作表 . 首先,您需要使用公共变量创建一个模块 .

    Public OldRange As Range
    Public NewRange As Range
    Public Table As ListObject
    

    然后,使用“工作簿”的“打开”事件 .

    Private Sub Workbook_Open()
        Dim sh As Worksheet
        Dim address As String
    
        For Each sh In Worksheets
            If sh.Name = "DATA" Then
                Worksheets("DATA").Activate
                ActiveSheet.Delete
            End If
        Next
    
        ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = "DATA"
    
    
        Set sh = ActiveWorkbook.Sheets("Plan1")
        sh.Activate
    
        Set Table = ActiveSheet.ListObjects("Rules")
        Set OldRange = Table.Range
        address = Table.Range.address
    
        Table.Range.Copy
    
        Set sh = ActiveWorkbook.Sheets("DATA")
        sh.Activate
        Range(address).PasteSpecial (xlPasteAll)
    End Sub
    

    然后,使用事件Worksheet_Change验证原始表的内容与之前保存的表 .

    Private Sub Worksheet_Change(ByVal Target As Range)
        Set Table = ActiveSheet.ListObjects("Rules")
    
        If Intersect(Target, Table.Range) Is Nothing Then Exit Sub 'this will guarantee that the change made in your sheet is in your desired table
    
        Set NewRange = Table.Range
    
        Dim rng As Range
        Dim rngaddr As String
        Dim TableChanged As Boolean
    
        TableChanged = False
    
        For Each rng In NewRange
            rngaddr = rng.address
            If rng.Value <> ActiveWorkbook.Sheets("DATA").Range(rngaddr).Value Then
                 'do something
                 TableChanged = True
            End If
        Next
    End Sub
    

    请记住:每次更改表格时都需要保存表格内容 .

相关问题