텍스트 문자열이 포함된 셀을 채우는 VBA 스크립트

텍스트 문자열이 포함된 셀을 채우는 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매우 우아한 해결책을 생각해낼 수 있었습니다.

단 5줄의 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

관련 정보