☰

用於填充包含任何文字字串的單元格的 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

人們在卓越先生網我們能夠想出一個非常優雅的解決方案。

事實證明，僅使用五行 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

相關內容