条件に一致するセルのカウントと色付けと置換

質問

こんにちは。
指定した文字列を選択範囲から検索し、
文字列を含むセルの個数のカウント&
セルの色付け&文字列の置換ができる
コードを教えてください。

<シート1>
A列:検索文字列
B列:置換後の文字列

<対象範囲>
別ブックの指定した範囲のみ

文字列の置換のみであればエラーなく
実行することができたのですが、
個数のカウントとセルの色付け方法が
いまいちわかりません。

vba初心者のため、簡単な解説を
つけていただけると嬉しいです。

なお、文字列の置換は以下のサイトを参考に
しています。
http://extan.jp/?p=5749

回答No.1

kkkkkm · ベストアンサー

以下のように追加すればいけると思います。

前略
Dim tmp As Variant '←追加
Dim mCnt As Long '←追加

中略

mCnt = 0 '←追加

For Each objParagraph In objRepRange

'複数条件の数分処理を繰り返します。
For i = LBound(arrRepWords, 1) To UBound(arrRepWords, 1)
'
tmp = objParagraph.Value '←追加　置換前の値を一時的に保存

'置換対象文字列に対し、変換後の文字列と変換前の文字列を置き換えます。
objParagraph.Value = Replace(objParagraph.Value, arrRepWords(i, 1), arrRepWords(i, 2))

'↓追加
If tmp <> objParagraph.Value Then '置換前と置換後で値に変化があれば置換された
objParagraph.Interior.Color = vbRed '←セルを赤に
mCnt = mCnt + 1 '←カウントアップ
End If
'↑追加ここまで

Next
Next

MsgBox mCnt 'カウント合計を表示

後略

お礼

ご丁寧な回答ありがとうございます🫧
こちらで試したところうまく行きました！

別に回答くださったコードとの
違いは勉強しながら確認します🙇🏻‍♀️

回答No.2

kkkkkm

No.1の追加です。別の方法だと以下でもいけるとおもいます。

前略

mCnt = 0
For Each objParagraph In objRepRange

'複数条件の数分処理を繰り返します。
For i = LBound(arrRepWords, 1) To UBound(arrRepWords, 1)

'検索文字列が置換対象セルに含まれているかどうか、かつ検索文字列が条件範囲内のセルに記載されているかどうか
If InStr(objParagraph.Value, arrRepWords(i, 1)) > 0 And arrRepWords(i, 1) <> "" Then

'置換対象文字列に対し、変換後の文字列と変換前の文字列を置き換えます。
objParagraph.Value = Replace(objParagraph.Value, arrRepWords(i, 1), arrRepWords(i, 2))
objParagraph.Interior.Color = vbRed
mCnt = mCnt + 1

End If

Next
Next

後略