VBA 条件付書式(番号比較)

他のシートに特定の値があった場合､両方に色を付ける

Sub auto_open()

Call CellsCondition

End Sub

Sub CellsCondition()

On Error GoTo ex

For Each ws In ThisWorkbook.Sheets

  If ws.Name <> "xxx" And ws.Name <> "xxx" Then
  
    ws.Columns("A").FormatConditions.Delete
    
    For r = 5 To 125
      For c = 1 To 1
        Set f = ws.Cells(r, c).FormatConditions.Add(xlExpression, xlEqual, CreateFormatConditionsString(r))
        f.Interior.Color = RGB(255, 0, 0)
        f.StopIfTrue = False
      Next c
    Next r
    
  End If
  
Next

Exit Sub

ex:

MsgBox "条件付書式の設定に失敗しました。"

End Sub

Function CreateFormatConditionsString(r)

For Each ws In Sheets
  If ws.Name <> "xxx" And ws.Name <> "xxx" Then
    tmp = tmp + "COUNTIF(" & ws.Name & "!C5:C125,C" & r & ")+"
  End If
Next

tmp = Left(tmp, Len(tmp) - 1) ' 最後の+を削除
CreateFormatConditionsString = "=AND((" & tmp & ")>1,C" & r & "<>""xxx"",C" & r & "<>""xxx"",C" & r & "<>""xxx"")"

End Function

Sub auto_open()

Call CellsCondition

End Sub

Sub CellsCondition()

On Error GoTo ex

For Each ws In ThisWorkbook.Sheets

If ws.Name <> "xxx" And ws.Name <> "xxx" Then

ws.Columns("A").FormatConditions.Delete

For r = 5 To 125

For c = 1 To 1

Set f = ws.Cells(r, c).FormatConditions.Add(xlExpression, xlEqual, CreateFormatConditionsString(r))

f.Interior.Color = RGB(255, 0, 0)

f.StopIfTrue = False

Next c

Next r

End If

Exit Sub

ex:

MsgBox "条件付書式の設定に失敗しました。"

End Sub

Function CreateFormatConditionsString(r)

For Each ws In Sheets

If ws.Name <> "xxx" And ws.Name <> "xxx" Then

tmp = tmp + "COUNTIF(" & ws.Name & "!C5:C125,C" & r & ")+"

End If

tmp = Left(tmp, Len(tmp) - 1) ' 最後の+を削除

CreateFormatConditionsString = "=AND((" & tmp & ")>1,C" & r & "<>""xxx"",C" & r & "<>""xxx"",C" & r & "<>""xxx"")"

End Function

条件だけ抜き出すと､
=AND((
COUNTIF(シート名!C5:C125,C20)+
COUNTIF(シート名!C5:C125,C20)
)>1,C20<>”比較除外”,C20<>”比較除外”,C20<>”比較除外”)
となっている｡