シート色塗り用

以下のVBAコードを使って、指定されたシートの特定の列を、別ブックの"rule"シートの1列目を参照して、文字列が一致するセルに"rule"シートと同じ色を塗ることができます。

vba
コードをコピーする
Sub ApplyColorsBasedOnRule()
Dim wbRule As Workbook
Dim wsRule As Worksheet
Dim ruleRange As Range
Dim cell As Range
Dim targetSheets As Variant
Dim targetColumns As Variant
Dim i As Integer
Dim j As Integer
Dim ws As Worksheet
Dim targetColumn As Range
Dim ruleCell As Range

' 参照するルールブックを開く
Set wbRule = Workbooks.Open("C:\Path\To\Your\RuleWorkbook.xlsx")
Set wsRule = wbRule.Sheets("rule")

' ルール範囲を設定 (1列目全体)
Set ruleRange = wsRule.Columns(1)

' 対象シートと列の配列を設定
targetSheets = Array("Story", "Likes", "Dislikes", "Impression")
targetColumns = Array("Story_base", "Likes_base", "Dislikes_base", "Imp_base")

' 各対象シートをループ
For i = LBound(targetSheets) To UBound(targetSheets)
    Set ws = ThisWorkbook.Sheets(targetSheets(i))
    Set targetColumn = ws.Range(targetColumns(i) & ":" & targetColumns(i))
    
    ' 対象列の各セルをループ
    For Each cell In targetColumn
        ' ルール範囲をループして一致する文字列を探す
        For Each ruleCell In ruleRange
            If cell.Value = ruleCell.Value Then
                ' 一致する文字列があれば、セルの色をルールのセルの色に設定
                cell.Interior.Color = ruleCell.Interior.Color
                Exit For
            End If
        Next ruleCell
    Next cell
Next i

' ルールブックを閉じる
wbRule.Close False

End Sub
手順:
上記のコードをコピーして、VBAエディターに貼り付けます。
Workbooks.Open行のパスを、実際のルールブックのパスに置き換えます。
マクロを実行します。
このコードは、"rule"シートの1列目の各セルの値を、指定されたシートの指定された列と比較し、一致する場合にそのセルの色を"rule"シートのセルの色に設定します。