Excelのマクロ『困ってます！』

質問

Excelで、以下のような機能を持ったマクロをつくりたいのですが、情けないのですが全くできません。
わかる方、どうかよろしくお願いいたします。

Ｓｈｅｅｔ1のＡ1～Ｄ1の値（例では、東京、練馬区、○○、△△）を、
全て「含む」Ｓｈｅｅｔ2のセルに目印をつけ（例は隣のセルに「○」と入力）し、

それが終わったらＳｈｅｅｔ1のＡ２～Ｄ２の値（例では、東京、練馬区、○○、□□）で・・・

の繰り返しです。

あくまでＳｈｅｅｔ1の値を全て「含む」ものが対象なので、Ｓｈｅｅｔ2の5行目のように、
余計な値（例では★）が混じっているものも対象としたいです。

例：

[Ｓｈｅｅｔ1]

1 |東京都|練馬区|○○ |△△ |

2 |東京都|練馬区|○○ |□□ |

3 |東京都|目黒区|●● |■■ |

4 |埼玉県|川口市|◇◇ |×× |

[Ｓｈｅｅｔ2]

1 ｜ |東京都港区・・・・

2 ｜ |東京都練馬区・・・・・

3 ｜ |東京都練馬区○○◎◎

4 |○|東京都練馬区○○△△

5 |○|東京都練馬区★○○★□□

6 ｜ ｜東京都練馬区★★□□

7 |○|東京都目黒区●●■■

8 |○|埼玉県川口市◇◇××

9 ｜ |神奈川県・・・・・

回答No.1

civic_sir2

こんな感じでどうでしょうか？
VBEを起動してモジュールを作成し、下のソースをコピペします。
後は、main関数を実行すればいけるはずです。

Sub main()
Sheets("Sheet2").Select
Range("a1").Select
Do Until ActiveCell.Value = ""
If ChkOne(ActiveCell.Offset(, 2).Value) Then
ActiveCell.Offset(, 1).Value = "○"
End If
ActiveCell.Offset(1).Select
Loop
End Sub

Function ChkOne(myStr As String) As Integer
Dim myRet As Integer
myRet = 0
Sheets("Sheet1").Select
Range("a1").Select
Do Until ActiveCell.Value = ""
If ChkAddress(myStr) Then
myRet = ActiveCell.Value
End If
ActiveCell.Offset(1).Select
Loop
Sheets("Sheet2").Select
ChkOne = myRet
End Function

Function ChkAddress(myStr As String) As Boolean
Dim myRet As Boolean
Dim myCell As String, i As Integer

myRet = False
i = 1
myCell = ActiveCell.Offset(, i).Value
Do Until myCell = ""
If InStr(myStr, myCell) > 0 Then
Else
GoTo EXIT_CHKADDRESS:
End If
myCell = ActiveCell.Offset(, i).Value
i = i + 1
Loop

myRet = True
EXIT_CHKADDRESS:
ChkAddress = myRet
End Function