Скрипт VBA для заполнения ячеек, содержащих любую текстовую строку

Question

Я пытаюсь создать скрипт VBA, который будет условно форматировать диапазон ячеек, содержащих любую текстовую строку, с цветом заливки по моему выбору.

До сих пор я использовал правило условного форматирования Excel для достижения этого, и оно работает; однако перетаскивание содержимого ячеек из одного столбца в другой приводит к тому, что правила условного форматирования становятся очень фрагментированными и быстро превращаются в беспорядок. То, что начиналось как два правила условного форматирования, одно для столбца A и другое для столбца B, быстро превращается в десятки отдельных правил, поскольку Excel изменяет поле «применяется к» правил при каждом копировании или перемещении данных ячейки.

Скрипт VBA, который способен достичь того же, что и мои правила условного форматирования, был бы намного лучше, поскольку на него не влияло бы перемещение или копирование и вставка данных ячеек. Я мог бы свободно перетаскивать свои данные в соответствующий столбец, не затрагивая при этом базовый код VBA.

Есть ли у кого-нибудь здесь с базовым опытом программирования VBA идеи для простого фрагмента кода, который я мог бы использовать, чтобы просто изменить цвет заливки любых ячеек, содержащих любую строку? Это будет применяться к ячейкам A1:A200.

Если по какой-то причине вам что-то не нравится в моем вопросе, как это недавно сделал Дэвид Постилл, пожалуйста, сообщите мне об этом в комментарии и дайте мне несколько минут, чтобы дополнить его любой дополнительной информацией, которую вы считаете необходимой, вместо того, чтобы ставить ему минус и уходить.

Только интересно услышать от людей с базовым опытом работы с VBA и желанием быть полезными. Пожалуйста, не пишите ехидных комментариев типа "Мы не собираемся отлаживать какой-то случайный скрипт, который вы нашли в сети". Я хочу услышать только от позитивных, ПОЛЕЗНЫХ людей.

Answer 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

Answer 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