Find関数内にFind関数をかける場合

質問

エラー91が発生し、手詰まりです。
どなたかご教授お願いいたします。

Find関数でDo～lppoを行い、初期の検索結果アドレスでLoopを抜けようと思ったのですが。。
エラーしてしまいました。

Find関数内にFind関数を用いることが出来ない
と目にしたのですが。
下記のようなVBAの場合
どのように対処したらいいでしょうか？

また、VBA初心者のため
VBA文が見づらかったり、おかしなところがあると思います。
その部分についても教えて頂けたらと思います。

Sub SAMPLE()
Dim TargetDE As String '文字列型
Dim TargetNo As String '文字列型
Dim PODate As String '文字列型
Dim FoundCell As Range '
Dim FoundDate As Range
Dim FoundCellNo As Long '長整数型
Dim FoundDateNo As String
Dim SearchArea As Object 'オブジェクト型
Dim tar_obj(1) As Object 'オブジェクト型
Dim Addr As String '文字列型

Dim Lastrom As Long

' Dim POLEFT As Range

'検索文字列入力（DE)
TargetDE = Application.InputBox("Fill in a DE:??", "DE:??", Type:=2)
If TargetDE = "False" Then Exit Sub

'検索対象範囲
Set SearchArea = Workbooks("Sample sample.xlsx").Sheets("Sample")
Set tar_obj(1) = Workbooks("INPUT FORMAT.csv").Sheets("INPUT FORMAT")

'表示先をクリア
tar_obj(1).Cells(1, 1).CurrentRegion.ClearContents

'検索実行
Set FoundCell = SearchArea.Range("C:C").Find(What:=TargetDE, LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False, MatchByte:=False)

'検索文字列(DE)を含むセルがない場合は終了
If FoundCell Is Nothing Then Exit Sub

'検索文字列入力（DE Number)
TargetNo = Application.InputBox("Fill in DE nomber", "Nomber", Type:=2)
If TargetNo = "False" Then Exit Sub

'最初の検索結果の行数を格納
Addr = FoundCell.Address

'検索文字列入力（PO Date)
PODate = Application.InputBox("Fill in Sample Date", "Date", Type:=2)
If PODate = "False" Then Exit Sub

Do
'検索Cell右横の値がTargetNoと同じ場合
If FoundCell.Offset(0, 1).Value = TargetNo Then

'行番号を代入
FoundCellNo = FoundCell.Row

'検索の下限値を変数に代入
F_LAST = FoundCellNo + 50

'検索実行
Set FoundDate = SearchArea.Range(SearchArea.Cells(FoundCellNo, 1), SearchArea.Cells(F_LAST, 1)).Find(What:=PODate, LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False, MatchByte:=False)

'検索文字列を含むセルがない場合は終了
If FoundDate Is Nothing Then
'MsgBox "Find is mistake"

'検索文字列を含むセルがある場合
Else

'変数に行番号代入
FoundDateNo = FoundDate.Row

If FoundDate.Offset(1, 1).Value = "" Then
MsgBox "The position of the cell is not correct. Please coordinate macro. "

Else

POLEFT = FoundDate.Offset(1, 1)

For i = 2 To 13

If FoundDate.Offset(1, i) <> 0 Then

If FoundDate.Offset(1, i) <> "." Then

If IsNumeric(FoundDate.Offset(1, i).Value) = True Then

'表示先(INPUT FORMAT)の行数をカウントアップ
cnt = cnt + 1

PORIGHT = FoundDate.Offset(1, i).Value

tar_obj(1).Range("E" & cnt) = POLEFT & PORIGHT

End If
End If
End If
Next i
End If
End If
ElseIf FoundCell.Offset(0, 1) <> TargetNo Then
' MsgBox "Find is mistake"

End If

'次の検索を実行
Set FoundCell = SearchArea.Range("C:C").FindNext(After:=FoundCell)

Loop While Not FoundCell Is Nothing And FoundCell.Address <> Addr

' If FoundCell.Offset(0, 1) <> TargetNo Then
' MsgBox "Not Find Number"
' End If

End Sub

回答No.2

eden3616

No1の添付画像の訂正です

回答No.1

eden3616

Findで検索したセルを対象に再度Findで絞り込むということでしょうか？
ご提示のコードに対する回答にはなりませんが・・・

セルA1～A10に以下のようなデータがあり、
「wa」をFind検索して、一致したセルを対象に「0」で再度Find検索しています。

aawdawdasda1
awdasdawad1
asdawdawdas0
awdasdwdadsa1
awdasdawdadwasd0
awdasdawdasdadwa0
awdasdawdawdasd0
awdasdawdasdasd1
dwasdasdawdasdadw0
asdwasdawdasda0

結果は以下のようになります。

Step1---A1:A18からwaを含むセル
$A$2
$A$5
$A$6
$A$9
$A$10
Step2---Step1から0を含むセル
$A$5
$A$6
$A$9
$A$10

添付画像を参考までに。。。

■VBAコード

Sub test()
'型宣言
Dim hit As Range
Dim bkhit As Range
Dim myRng As Range

Debug.Print "Step1---A1:A18からwaを含むセル"
'1つ目のマッチセルを検索
Set hit = Range("A1:A18").Find("wa")
'1つ目のマッチセルを記憶
Set bkhit = hit
Do
　　'デバッグ表示
　　Debug.Print hit.Address
　　'マッチしたセルを変数へ格納
　　If myRng Is Nothing Then
　　　　Set myRng = hit
　　Else
　　　　Set myRng = Union(myRng, hit)
　　End If
　　'次のマッチセルを検索
　　Set hit = Range("A1:A18").FindNext(hit)
　　'1つ目のマッチセルアドレスと一致したら終了
Loop Until bkhit.Address = hit.Address

Debug.Print "Step2---Step1から0を含むセル"
'1つ目のマッチセルを検索
Set hit = myRng.Find("0")
'1つ目のマッチセルを記憶
Set bkhit = hit
Do
　　'デバッグ表示
　　Debug.Print hit.Address
　　'次のマッチセルを検索
　　Set hit = myRng.FindNext(hit)
　　'1つ目のマッチセルアドレスと一致したら終了
Loop Until bkhit.Address = hit.Address

End Sub