VBAで前方一致するセル数を検索するマクロ

質問

画像の作業をVBAで作成するには、どのような方法がありますか？
---------------------------------------------------------------

"ABC"から始まるデータの個数（左3文字が"ABC"のデータの個数）が
Sheet1とSheet2で同じであれば、

"ABC"から始まるセルをすべて黄色に塗りつぶし

異なっていれば、

msgbox "不一致"

と表示する

---------------------------------------------------------------
ロジックだけでも構いません、
ご教示頂れば幸いです

回答No.1

kkkkkm · ベストアンサー

以下のような方法でいかがですか。

Sub Test()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim MyRange1 As Range, MyRange2 As Range
Dim SStr As String

Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")
Set MyRange1 = Sh1.Range(Sh1.Cells(1, "A"), Sh1.Cells(Rows.Count, "A").End(xlUp))
Set MyRange2 = Sh2.Range(Sh2.Cells(1, "A"), Sh2.Cells(Rows.Count, "A").End(xlUp))
SStr = "ABC*"

If Application.WorksheetFunction.CountIf(MyRange1, SStr) = _
Application.WorksheetFunction.CountIf(MyRange2, SStr) Then
Call Cell_SetColor(MyRange1, SStr)
Call Cell_SetColor(MyRange2, SStr)
Else
MsgBox "不一致", vbInformation
End If

Set MyRange1 = Nothing
Set MyRange2 = Nothing
Set Sh1 = Nothing
Set Sh2 = Nothing
End Sub

Function Cell_SetColor(ByRef MyRange As Range, ByVal SStr As String)
Dim c As Range
For Each c In MyRange
If c.Value Like SStr Then
c.Interior.Color = vbYellow
End If
Next
End Function