ここから本文です

エクセル2010で、2つのセルの文字列を比較し、異なっている文字だけを赤字にする方...

アバター

ID非公開さん

2018/10/2817:27:06

エクセル2010で、2つのセルの文字列を比較し、異なっている文字だけを赤字にする方法を教えてください。

エクセル2010を使って進捗管理をしています。

更新前のシートと、更新後のシートを比較し、更新された部分(文字)だけを赤字にしたいと思っています。(画像にて例を示しています。)
ワードの比較機能と同じような処理を想定しています。

マクロを見よう見まねで組み、「更新前のシートと更新後のシートを比較して、異なっているセルの文字を赤字にする」ことはできましたが、
これでは更新されたセルに含まれるすべての文字が赤字になってしまい、異なっている文字だけを赤字にすることはできませんでした。

マクロを組みなおそうにも、方針すら立たない状態です。
ウェブで調べても有用な情報は入手できませんでした。

そこで、「2つのセル内の文字列を比較し、異なっている文字だけを赤字にする」ためのマクロを組む方針や、マクロ以外に有用な方法を教えていただきたいです。
よろしくお願いいたします。


追記:マクロの方針として、例えば、各セルごとにワードを開いて文書比較させて比較の結果をエクセルの該当セルに貼り付ける、なんていうのもありでしょうか。

補足2つ目までのご回答で、セル内の文字列を頭から1文字ずつ比較することはできるようになりました。
これにより、画像のC5セル以外については、更新された文字色を赤にするのとができました。

しかし、画像のC5セル内のように、セル内の文字列の途中に文字を追加(xx会社)した場合に追加した文字だけを赤字にすることができません。
例:
更新前
・今日は天気がよかった

更新後
・今日と明日は天気がよかった

'と明日'が追加されていますが、この状態で「頭から1文字ずつ比較」を実行すると、
'と明日'だけでなく、'と明日は天気がよかった。'が赤字になってしまいます。

この問題も解決できる方法をご教示いただきたいです。



diffなどのアルゴリズムを勉強する必要がありますかね…?

ws2.Cells,Font.ColorIndex,エクセル,ws1.Cells,赤字,StrReverse,xlAutomatic

閲覧数:
264
回答数:
2
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

mek********さん

2018/11/223:03:46

ご質問者の[補足]内の不具合に対するコ-ド修正のため
回答を取り消して、再度投稿しております。
返信で修正コ-ド全文を提示するのは、
分割作業となるため、みづらくなると判断

今日は天気がよかった …更新前

今日と昨日は天気がよかった …更新後

の場合、
”と昨日は” の部分のみ赤字

東京都港区 …更新前

東京都江東区 …更新後
の場合
”江東” の部分のみ赤字


今回、この不具合については、
文字数増に対応する一例です。
さらなる不具合の可能性はありますが、
取り急ぎの対応です。
また、英文の場合、単語ごとのスペルとか、
単語間のスぺ-スなどの問題とかも、
殆ど考慮しておりません。
また、日本文においても、
会話文の「」の挿入、や、
Excelのセルの場合、
セル内改行における、
その判定とその処理も含めておりません。
文字数減には対応していません。
以上の点は、今後の課題なのかもしれません。

数値列および日付での一字ごとの
比較プロシ-ジャ(別シ-ト抽出後での色付け)は、
回答文字数を超えるため、
今回提示をしておりません。
(先に提示したコ-ドでは、日付の違いでの
文字色処理はふくまれておりませんので、
_HikakuSht_2_の修正コ-ドを参考に、
お考えください。)



[現時点での処理内容]

更新前のシ-トのシート名を"Sheet1"
更新後のシ-トのシート名を"Sheet2"
とします。
ただし、両シ-トともに、
レイアウト(データの入力セルの位置等)が全く同じ、
という条件になります。

コ-ド内のシ-ト名については、
.... 実際のシ-ト名に合わせて、この記述部分を、
.... 置き換えてください。

更新後のシ-トをアクテイブにして、
下記プロシ-ジャ_HikakuSht_2_を実行しますと、

文字列のセルで、変更がある場合は、
異なっている文字だけを赤字にします。
更新後に
空欄化または数値列のセルで変更がある場合は、
セルの背景色を、ピンクにします。
日付書式で、違いがある場合は、
セルの背景色を、黄色にします。


上記の処理で
(文字やセルの背景に)
色付けをしたシ-トで、
元に戻す場合は、
当該シ-トをアクテイブにして、
_Irokaijyo_文字列用
を、””単体””で実行してみてください。


' 標準モジュールへ

Option Explicit

Sub HikakuSht_2()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim i As Long, j As Integer
Dim EndR As Long, EndC As Integer
Dim K As Integer, N As Integer
Dim L1 As Integer, L2 As Integer
Dim Ch1 As Integer, Ch2 As Integer

Application.ScreenUpdating = False

Set Ws1 = Worksheets("Sheet1") ' 更新前のシ-ト
Set Ws2 = Worksheets("Sheet2") ' 更新後のシ-ト

Ws2.Activate

Call Irokaijyo

With Ws2.UsedRange
EndR = .Rows(.Rows.Count).Row
EndC = .Columns(.Columns.Count).Column
End With

For j = 1 To EndC
For i = 1 To EndR

If Ws2.Cells(i, j) <> Ws1.Cells(i, j) Then
' 対象セルが空欄または数値列の場合
If Ws2.Cells(i, j) = "" Or IsNumeric(Ws2.Cells(i, j)) = True Then
Ws2.Cells(i, j).Interior.ColorIndex = 7
' 対象セルが日付の場合
ElseIf IsDate(Ws2.Cells(i, j)) = True Then
If CDate(Ws2.Cells(i, j)) <> CDate(Ws1.Cells(i, j)) Then
Ws2.Cells(i, j).Interior.ColorIndex = 6
End If
' 対象セルが文字列の場合
ElseIf IsNumeric(Ws2.Cells(i, j)) = False Then
L1 = Len(Ws2.Cells(i, j))
L2 = Len(Ws1.Cells(i, j))

If L1 > L2 Then
If L1 Mod 2 = 0 Then
Ch1 = L1 / 2
For K = 1 To Ch1
If Mid(Ws2.Cells(i, j), K, 1) <> "" Then
If Mid(Ws2.Cells(i, j), K, 1) <> Mid(Ws1.Cells(i, j), K, 1) Then
Ws2.Cells(i, j).Characters(Start:=K, Length:=1).Font.ColorIndex = 3
Else
Ws2.Cells(i, j).Characters(Start:=K, Length:=1).Font.ColorIndex = xlAutomatic
End If
End If
Next
For K = 1 To Ch1
If Mid(StrReverse(Ws2.Cells(i, j)), K, 1) <> "" Then
If Mid(StrReverse(Ws2.Cells(i, j)), K, 1) <> _
Mid(StrReverse(Ws1.Cells(i, j)), K, 1) Then
Ws2.Cells(i, j).Characters(Start:=L1 - K + 1, Length:=1).Font.ColorIndex = 3
Else
Ws2.Cells(i, j).Characters(Start:=L1 - K + 1, Length:=1).Font.ColorIndex = xlAutomatic
End If
End If
Next

Else
Ch2 = Int(L1 / 2)
For K = 1 To Ch2
If Mid(Ws2.Cells(i, j), K, 1) <> "" Then
If Mid(Ws2.Cells(i, j), K, 1) <> Mid(Ws1.Cells(i, j), K, 1) Then
Ws2.Cells(i, j).Characters(Start:=K, Length:=1).Font.ColorIndex = 3
Else
Ws2.Cells(i, j).Characters(Start:=K, Length:=1).Font.ColorIndex = xlAutomatic
End If
End If
Next
For K = 1 To Ch2 + 1
If Mid(StrReverse(Ws2.Cells(i, j)), K, 1) <> "" Then
If Mid(StrReverse(Ws2.Cells(i, j)), K, 1) <> _
Mid(StrReverse(Ws1.Cells(i, j)), K, 1) Then
Ws2.Cells(i, j).Characters(Start:=L1 - K + 1, Length:=1).Font.ColorIndex = 3
Else
Ws2.Cells(i, j).Characters(Start:=L1 - K + 1, Length:=1).Font.ColorIndex = xlAutomatic
End If
End If
Next

End If

Else
N = Len(Ws2.Cells(i, j))
For K = 1 To N
If Mid(Ws2.Cells(i, j), K, 1) <> "" Then
If Mid(Ws2.Cells(i, j), K, 1) <> Mid(Ws1.Cells(i, j), K, 1) Then
Ws2.Cells(i, j).Characters(Start:=K, Length:=1).Font.ColorIndex = 3
Else
Ws2.Cells(i, j).Characters(Start:=K, Length:=1).Font.ColorIndex = xlAutomatic
End If
End If
Next
End If
End If
End If
Next
Next

Application.ScreenUpdating = True

Set Ws1 = Nothing
Set Ws2 = Nothing

End Sub


Sub Irokaijyo()

With ActiveSheet

.Cells.Interior.ColorIndex = xlColorIndexNone
.Cells.Font.ColorIndex = xlAutomatic

End With

End Sub

アバター

質問した人からのコメント

2018/11/4 00:03:51

何度も投稿してきただきありがとうございました。
最新版はまだ確認できておりませんが、ベストアンサーとさせていただきます。

ベストアンサー以外の回答

1〜1件/1件中

be_********さん

2018/10/2818:17:05

それっぽいのがググると出てきたw

https://teratail.com/questions/102855

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

あわせて知りたい

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる