こんな感じでしょうか。
無限ループしそうで怖い…。
対策は適宜入れてください。
VBA
1Dim rowA As Long
2Dim rowD As Long
3
4rowA = 1
5rowD = 1
6Do
7 If Cells(rowA, 1).Value = Cells(rowD, 4).Value Then
8 If Cells(rowD, 1).Value = "●" Then
9 Debug.Print "お目当て:" & Cells(rowD, 6).Value
10 Exit Do
11 Else
12 rowA = rowD
13 End If
14 End If
15 rowD = rowD + 1
16Loop
2/14 18:13の質問の回答
データがなくなったらループを抜ける処理を追加。
A列D列ともにデータが連続して格納されている前提です。
VBA
1Dim rowA As Long
2Dim rowD As Long
3
4rowA = 1
5rowD = 2 ' ←2行目からに変更しました
6Do
7 ' A列D列の終了判定
8 If Cells(rowA, 1).Value = "" Or Cells(rowD, 1).Value = "" Then
9 Debug.Print "終了:お目当て発見できず"
10 Exit Do
11 End If
12 If Cells(rowA, 1).Value = Cells(rowD, 4).Value Then
13 If Cells(rowD, 1).Value = "●" Then
14 Debug.Print "お目当て:" & Cells(rowD, 6).Value
15 Exit Do
16 Else
17 rowA = rowD
18 End If
19 End If
20 rowD = rowD + 1
21Loop
22