主页 / computer / 问题 / 1463536
Accepted
Mr Ethernet
Asked: 2019-07-25 05:47:49 +0800 CST

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

  • 772

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

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

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

这里是否有任何具有基本 VBA 编码经验的人对一段简单的代码有任何想法，我可以使用它来简单地更改包含任何字符串的任何单元格的填充颜色？它适用于单元格 A1:A200。

如果您出于某种原因不喜欢我的问题，就像 David Postill 最近所做的那样，请在评论中告诉我，并给我几分钟时间用您认为可能需要的任何其他信息更新它，而不是否决它和匆匆离去。

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

microsoft-excel vba

2 个回答

  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
    • 3
  2. Best Answer

    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
    • 0

相关问题