『文字列も比べて違ったら違う箇所だけ色を変える』（てんじゃき）
お世話になります。
例えばセル1には
１２３４５
と入力されており、
セル2には
２２３４６
と入力されております。
そこで
セル１とセル２を見比べ、
セル２がセル1と違う文字にのみ色を付けたいです。
今の例でいうと、
セル２の
最初の２と最後の６に色がつくようにしたいです、
出来ますでしょうか。
宜しくお願いします。
＜ 使用 Excel：unknown、使用 OS：unknown ＞
二つの文字列は数字だけなんですか？ 同じ文字数に限るんですか？ 単に、対応する位置の文字列を比較すれば済む話ですか？ そうではなくて、例えば、ABCDとXABCなどというとき、Xが追加され、Dが消去されたと考え、 DとXに色をつけるといったケースもあるんですか？ そうであれば、比較的有名な"最長共通部分列"という話になりますね。過去ログがありそうです。書いた記憶が あります。
前提を明確にして、サンプルをいくつか提示することを推奨します。 また、ExcelのバージョンとOSを書いて下さい。（このケースでは余り影響ないかもしれませんが）
（xyz） 2025/06/18(水) 09:37:24
Excel2021以上限定、マクロ不使用、作業列使用、条件付き書式使用、メチャ強引仕様。
例えば以下のようなレイアウトとする。 A B C D E F G 1 12345 1 2 3 4 5 2 22346 2 2 3 4 6
C1 =MID(A1:A2,SEQUENCE(1,5),1)
●条件付き書式
＜適用先＞ =$C$2:$G$2
＜数式＞ =C2<>C1
＜書式＞ 適当に設定
※これで C2 と G2 に設定した書式が反映されます。
（行きずり） 2025/06/18(水) 10:02:47
>セル２がセル1と違う文字にのみ色を付けたいです。 提示の値が数値なら一部分の書式の変更は出来ません （はてな） 2025/06/18(水) 10:30:56
皆さんからの回答やご指摘もありますし、私の確認質問をあります。 ボールは質問者さんが持っているという認識です。 こちらに投げ返していただかないと膠着状態ですよ。
（xyz） 2025/06/18(水) 16:54:19
反応がないのが残念です。 メモしておいたものをアップして閲覧者の参考に供します。
(1)両者の文字列数が同じで、同じ位置どうしを比較して差をB列に表示する前提
サンプル
12345 22346
ABCD XABC
(YukiWikiの仕様上色は使えないので、太字で示しています）
セル内の各文字に色をつけようとするならマクロによらざるを得ないと思います。
コード例
Sub test()
Dim k As Long, j As Long
Dim s1 As String, s2 As String
For k = 1 To Cells(Rows.Count, "A").End(xlUp).Row
s1 = Cells(k, 1)
s2 = Cells(k, 2)
For j = 1 To Len(s1)
If Mid(s1, j, 1) <> Mid(s2, j, 1) Then
Cells(k, 2).Characters(Start:=j, Length:=1).Font.Color = vbRed
End If
Next
Next
End Sub
（なお、ご指摘どおり数値ではNGなので、書式を文字列にして数字を入力してください。
また、数式の結果も不可です。いったん値にして文字列にしてください。）
(2)おまけ。 必ずしも文字数が同じとは限らず、 「両方に共通する部分文字列のうち最長の文字列」以外の文字列に色を着けるという前提。
サンプル
12345 22346
123 1234
123 9123
12345 1234
ABCD XABC
コード例（以下を標準モジュールにコピーして、mainを実行してください。）
Dim lcs() As Long Dim dic1 As Object Dim dic2 As Object Dim s1 As String Dim s2 As String Dim ws1 As Worksheet
Sub main()
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
Set ws1 = Worksheets("Sheet1")
Dim k As Long
For k = 1 To ws1.Cells(ws1.Cells.Rows.Count, 1).End(xlUp).Row
diff ws1.Cells(k, 1), ws1.Cells(k, 2)
Next
End Sub
Sub diff(r1 As Range, r2 As Range)
dic1.RemoveAll
dic2.RemoveAll
' 二つの文字列のLCSの長さを求める(lcs()が結果）
get_lcs r1, r2
'それに対応する最長共通部分列を求める(dic1,dic2が結果である)
get_lcs_string r1.Value, r2.Value
'最長共通部分列に該当しない文字列に、書式を設定（赤、アンダーライン）
setColor r1, r2
End Sub
Rem 最長共通部分列に関する行列 lcs を作成
Function get_lcs(r1 As Range, r2 As Range)
Dim j As Long, k As Long
s1 = r1.Value
s2 = r2.Value
' lcs(j,k) は s1の1からjまでの部分列と
' s2の1からkまでの部分列との
' LCSの長さを示す
ReDim lcs(0 To Len(s1), 0 To Len(s2))
For j = 1 To Len(s1)
For k = 1 To Len(s2)
If Mid(s1, j, 1) = Mid(s2, k, 1) Then
lcs(j, k) = lcs(j - 1, k - 1) + 1
Else
lcs(j, k) = WorksheetFunction.Max(lcs(j, k - 1), lcs(j - 1, k))
End If
Next
Next
End Function
Rem 共通部分文字列のそれぞれの文字列における位置を、dic1,dic2にそれぞれ保持
Function get_lcs_string(s1 As String, s2 As String)
's1の共通部分文字の位置 を dic1の keyに保持
's2の共通部分文字の位置 を dic2の keyに保持
get_lcs_string_sub Len(s1), Len(s2)
End Function
Function get_lcs_string_sub(j As Long, k As Long)
If j = 0 Or k = 0 Then Exit Function
If Mid(s1, j, 1) = Mid(s2, k, 1) Then
Call get_lcs_string_sub(j - 1, k - 1)
dic1(j) = Empty 's1 の j番目の文字がLCSを構成
dic2(k) = Empty 's2 の k番目の文字がLCSを構成
Else
If lcs(j - 1, k) >= lcs(j, k - 1) Then
Call get_lcs_string_sub(j - 1, k)
Else
Call get_lcs_string_sub(j, k - 1)
End If
End If
End Function
Function setColor(r1 As Range, r2 As Range)
Dim k As Long
Range(r1, r2).Font.ColorIndex = xlAutomatic
' Range(r1, r2).Font.Underline = xlUnderlineStyleNone
'マッチしない文字列(=共通部分列以外の文字）の文字色を赤に
For k = 1 To Len(r1.Value)
If Not dic1.exists(k) Then
With r1.Characters(Start:=k, Length:=1).Font
.Color = vbRed
' .Underline = xlUnderlineStyleSingle
End With
End If
Next
For k = 1 To Len(r2.Value)
If Not dic2.exists(k) Then
With r2.Characters(Start:=k, Length:=1).Font
.Color = vbRed
' .Underline = xlUnderlineStyleSingle
End With
End If
Next
End Function
# 普通はDiff系のツールを使うのでしょうけど、昔、学習目的で書いたものです。
（xyz） 2025/06/20(金) 15:09:54
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.