任意のテキスト文字列を含むセルに入力する VBA スクリプト

Question

任意のテキスト文字列を含むセルの範囲を、選択した塗りつぶし色で条件付きで書式設定する VBA スクリプトを作成しようとしています。

これまでのところ、私は Excel の条件付き書式設定ルールを使用してこれを実現しており、うまく機能しています。しかし、セルの内容をある列から別の列にドラッグ アンド ドロップすると、条件付き書式設定ルールが非常に断片化され、すぐに混乱が生じます。列 A 用と列 B 用の 2 つの条件付き書式設定ルールとして始まったものが、セル データをコピーまたは移動するたびに Excel がルールの「適用先」フィールドを変更するため、すぐに数十の個別のルールになります。

条件付き書式設定ルールと同じことを実現できる VBA スクリプトの方が、セル データの移動やコピー アンド ペーストによる影響を受けないので、はるかに優れています。基礎となる VBA コードに影響されることなく、データを適切な列に自由にドラッグ アンド ドロップできます。

基本的な VBA コーディングの経験がある方で、文字列を含むセルの塗りつぶし色を変更するために使用できる簡単なコードのアイデアをお持ちの方はいらっしゃいますか? セル A1:A200 に適用されます。

何らかの理由で私の質問に気に入らない点がある場合は、David Postill が最近したように、コメントで私に伝えてください。そして、反対票を投じて急いで立ち去るのではなく、必要と思われる追加情報で質問を更新するのを数分待ってください。

基本的な 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。

この厄介な問題を思い出させてくれたので、条件付き書式設定ルール内の断片化されたアドレスを修正するマクロを作成しました。このマクロは、条件付き書式設定ルールが 1 列または複数列全体に適用される場合にのみ役立ちます。

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

の皆さん翻訳者非常にエレガントな解決策を思いつくことができました。

わずか 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 コード全体を次に示します。

最初のセクションでは自動アルファベット順の処理が行われ、この新しい 2 番目のセクションでは条件付き書式設定が処理されます。

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