☰

VBA 脚本用于填充包含任何文本字符串的单元格

tag-icon • tag-icon microsoft-excel vba conditional-formatting
VBA 脚本用于填充包含任何文本字符串的单元格

我正在尝试创建一个 VBA 脚本，该脚本将有条件地格式化包含任何文本字符串的单元格区域并使用我选择的填充颜色。

到目前为止，我使用 Excel 条件格式规则来实现这一点，并且它有效；但是，将单元格内容从一列拖放到另一列会导致条件格式规则变得非常分散，很快就会变得一团糟。最初是两个条件格式规则，一个用于 A 列，另一个用于 B 列，但随着 Excel 每次复制或移动单元格数据时都会更改规则的“适用于”字段，因此很快就会变成几十条单独的规则。

在此处输入图片描述

能够实现与我的条件格式规则相同功能的 VBA 脚本会更好，因为它不会受到移动或复制和粘贴单元格数据的影响。我可以自由地将数据拖放到相应的列中，而不会影响底层 VBA 代码。

这里有没有人有基本的 VBA 编码经验，能不能给我一些简单的代码，让我可以简单地更改包含任何字符串的单元格的填充颜色？它适用于单元格 A1:A200。

如果您因为某种原因不喜欢我的问题中的某些内容，就像 David Postill 最近所做的那样，请在评论中告诉我，并给我几分钟时间用您认为必要的任何其他信息来更新它，而不是对其进行否决然后匆匆离开。

只对具有一些基本 VBA 经验并愿意提供帮助的人感兴趣。请不要发表“我们不会为您调试您在网上找到的一些随机脚本”之类的尖刻评论。我只想听到积极、乐于助人的人的意见。

答案1

正如您所描述的，条件格式可能会变得支离破碎，这很烦人。我尝试编写适用于整个列或多列的条件格式规则。然后我可以将支离破碎的地址改$B$24,$B$25:$C$25,$B$27:$C$1048576,$B$26,$B$21:$C$23,$B$1:$C$19,$B$20回$B:$C。

既然你提醒了我这个烦恼，我就写了一个宏来修复条件格式规则中的碎片地址。只有当条件格式规则适用于整个列或多列时，宏才会有帮助。

Sub ApplyConditionalFormattingToEntireColumns()
    Dim oneFormatCondition As FormatCondition
    Dim strAddresses() As String, lngA As Long
    Dim strFirst As String, strLast As String, strCheck As String

    For Each oneFormatCondition In ActiveSheet.Cells.FormatConditions
        strFirst = ""
        strLast = ""
        'Splits each condition's addresses into an array.
        strAddresses = Split(oneFormatCondition.AppliesTo.Address, ",")
        For lngA = LBound(strAddresses) To UBound(strAddresses)
            'Finds and saves the first column.
            strCheck = strAddresses(lngA)
            strCheck = Mid(strCheck, 2, _
                InStr(2, strCheck, "$", vbTextCompare) - 2)
            If strFirst = "" Then strFirst = strCheck
            If strLast = "" Then strLast = strCheck
            If strFirst > strCheck Then strFirst = strCheck
            If strLast < strCheck Then strLast = strCheck
            'Finds and saves the last column.
            strCheck = strAddresses(lngA)
            If InStr(2, strCheck, ":", vbTextCompare) > 0 Then
                strCheck = Right(strCheck, Len(strCheck) - _
                    InStr(2, strCheck, ":", vbTextCompare))
                strCheck = Mid(strCheck, 2, _
                    InStr(2, strCheck, "$", vbTextCompare) - 2)
                If strLast < strCheck Then strLast = strCheck
            End If
        Next lngA
        'Modifies each condition's address to entire columns.
        oneFormatCondition.ModifyAppliesToRange _
            Range("$" & strFirst & ":$" & strLast)
    Next oneFormatCondition
End Sub

答案2

那边的人们MrExcel.com能够想出一个非常优雅的解决方案。

事实证明，仅使用五行 VBA 代码就可以复制我现有的条件格式规则的功能。由于条件格式逻辑现在由一个小宏来处理，因此规则在数据移动时被更改的问题不再会发生。

我花了几分钟测试它，效果很好。我现在已经删除了所有条件格式规则，并且相同的条件格式行为通过此 VBA 代码继续存在：

With Range("A1:B200")
  .Interior.Color = xlNone
  .Resize(, 1).SpecialCells(xlConstants).Interior.ColorIndex = 22
  .Offset(, 1).Resize(, 1).SpecialCells(xlConstants).Interior.ColorIndex = 36
End With

就上下文而言，这是我现在在此工作表上使用的完整 VBA 代码。

第一部分处理自动字母排序，而新的第二部分处理条件格式：

Private Sub Worksheet_Change(ByVal Target As Range)

Range("A1:A200").Sort Key1:=Range("A1"), _
  Order1:=xlAscending, Header:=xlNo, _
  OrderCustom:=1, MatchCase:=False, _
  Orientation:=xlTopToBottom

      Range("B1:B200").Sort Key1:=Range("B1"), _
  Order1:=xlAscending, Header:=xlNo, _
  OrderCustom:=1, MatchCase:=False, _
  Orientation:=xlTopToBottom

With Range("A1:B200")
  .Interior.Color = xlNone
  .Resize(, 1).SpecialCells(xlConstants).Interior.ColorIndex = 22
  .Offset(, 1).Resize(, 1).SpecialCells(xlConstants).Interior.ColorIndex = 36
End With

End Sub

相关内容