セルの値を比較して赤字にする
Sub CompareAndHighlightDifferences()
Dim lastRow As Long
Dim i As Long
Dim valA As String, valB As String
Dim j As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To lastRow
' Cells(i, "A")のAを変えると列を変えれる
valA = Trim(Cells(i, "A").Value)
valB = Trim(Cells(i, "B").Value)
' 初期状態に戻す(黒にリセット)
With Cells(i, "B")
.Font.Color = RGB(0, 0, 0)
.Characters.Font.Color = RGB(0, 0, 0)
End With
If valA <> "" And valB = "" Then
' A列に文字あり、B列が空白 → スキップ
GoTo ContinueLoop
ElseIf valA = "" And valB <> "" Then
' A列が空白、B列に文字 → B列全部赤字
With Cells(i, "B").Characters(1, Len(valB)).Font
.Color = RGB(255, 0, 0)
End With
ElseIf valA <> "" And valB <> "" Then
' 両方に文字がある → 1文字ずつ比較
For j = 1 To Len(valB)
If Mid(valA, j, 1) <> Mid(valB, j, 1) Then
If j <= Len(valB) Then
Cells(i, "B").Characters(j, 1).Font.Color = RGB(255, 0, 0)
End If
End If
Next j
End If
ContinueLoop:
Next i
End Sub
使い方
- ExcelでAlt + F11 を押してVBAエディタを開く
- 挿入>モジュールから新しいモジュールを作成
- 上記コードを貼り付ける
- F5 またはExcel側のマクロ実行で処理開始