Findステートメントで別なブックの検索

質問

Findステートメントで検索した内容のある行のA列にある値をキーワードとして別なブックのA列に検索をかけてヒットしたセルの内容を元のブックの指定したセルに移すという動作をさせたいので次ののように書いてみました。
Private Sub CommandButton2_Click()
Dim Yline As Long
Dim No As Variant
Dim c As Range
Dim sh As Worksheet
Dim sh_no As Integer
Dim findcell As Range
Dim add As String

Set sh = Worksheets("ブックAの1")
No = TextBox1.Text
sh_no = 1

'テキストボックスに値が入っていた場合
If No <> "" Then
'Find メソッドの最低のプロパティは入れる。SearchOrder は特にいらない
Set c = sh.Range("B:B").Find( _
What:=No, _
LookIn:=xlValues, _
LookAt:=xlPart, _
Searchorder:=xlByRows)
'見つかった場合にのみ、値を入れる
If Not c Is Nothing Then
Yline = c.Row
'見つかった行のA列の文字列でブックBに検索をかける
add = sh.Cells(Yline, 1).Value
Workbooks("B").Activate
Set findcell = Workbooks("B").Worksheet(sh_no).Range("A:A").Find( _
What:=add, _
LookIn:=xlValues, _
LookAt:=xlPart, _
Searchorder:=xlByRows)
'前Setステートメントからのループ検索開始
If findcell Is Nothing Then
Do
sh_no = sh_no + 1
If sh_no > ThisWorkbook.Worksheets.Count Then
Exit Sub
End If
Set findcell = Workbooks("B").Worksheets.(sh_no).Range("A:A").Find( _
What:=add, _
LookIn:=xlValues, _
LookAt:=xlPart, _
Searchorder:=xlByRows)
Loop While findcell Is Nothing
End If
End If
Workbooks("A").Activate
With Worksheets("Aの2")
　　.Cells(21, 4).Value = sh.Cells(Yline, 14).Value
.Cells(20, 4).Value = sh.Cells(Yline, 15).Value
.Cells(36, 4).Value = findcell
End With
Unload Me
Else
MsgBox No & " は見つかりません。", 48
End If
Set sh = Nothing
End Sub

するとwhat:=addとしてaddが見つかるまでシート番号を増やしていくループのところでエラーがでてキーワードが見つからないと出ます。恐らくブックBを検索してくれているとは思うのです。A列に空白があるためかと思い埋めてみましたが関係ないようです。
構文エラー的なものは無いと思いますが、宜しくお願いします。

回答No.3

n-jun · ベストアンサー

ANo.2です。

取り敢えずデータがどのような物か不明ですし、ユーザーフォームは無視してテストした物です。

Sub try()
Dim Yline As Long
Dim No As Variant
Dim c As Range
Dim sh As Worksheet
Dim sh_no As Integer
Dim findcell As Range
Dim add As String

Set sh = ThisWorkbook.Worksheets("Sheet1")
No = "aaa" 'TextBox1.Text
sh_no = 1

'テキストボックスに値が入っていた場合
If No <> "" Then
'Find メソッドの最低のプロパティは入れる。SearchOrder は特にいらない
Set c = sh.Range("B:B").Find( _
What:=No, _
LookIn:=xlValues, _
LookAt:=xlPart, _
Searchorder:=xlByRows)
'見つかった場合にのみ、値を入れる
If Not c Is Nothing Then
Yline = c.Row
'見つかった行のA列の文字列でブックBに検索をかける
add = sh.Cells(Yline, 1).Value
Workbooks("B.xls").Activate
With Workbooks("B.xls").Worksheets(sh_no)
Set findcell = .Range("A:A").Find( _
What:=add, _
After:=.Range("A" & Rows.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
Searchorder:=xlByRows)
End With
'前Setステートメントからのループ検索開始
If findcell Is Nothing Then
Do
sh_no = sh_no + 1
If sh_no > ThisWorkbook.Worksheets.Count Then
Exit Sub
End If
With Workbooks("B.xls").Worksheets(sh_no)
Set findcell = .Range("A:A").Find( _
What:=add, _
After:=.Range("A" & Rows.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
Searchorder:=xlByRows)
End With
Loop While findcell Is Nothing
End If
End If
Workbooks("A.xls").Activate
With Worksheets("Sheet2")
.Cells(21, 4).Value = sh.Cells(Yline, 14).Value
.Cells(20, 4).Value = sh.Cells(Yline, 15).Value
.Cells(36, 4).Value = findcell
End With
'Unload Me
Else
MsgBox No & " は見つかりません。", 48
End If
Set sh = Nothing
End Sub

無限ループにはなりませんが、あっているのか検証に不安はあります。

補足

何度もありがとうございます。
この時間までかかってやっと解決の糸口が見えてきました。
No3の修正を加えてみましたが実行結果は変わりませんでした。
前回の補足で検索対象を見つけてくれているのかいないのかがあやふやだといいましたが、それを確かめるためにDo～Loopに入ってからブックBのシート数をオーバーしたときプロシージャを抜ける前に
Msgbox"検索文字列が見当たりません".vbinfomation
を入れてみたところ見事にメッセージが出ました。
では、ブックBの構成が悪いのかと思いましたが今までの経験上特に構成自体は問題ないと思いました。
そこで、「じゃあ完全一致なら見つけられるのか？」と思い、ブックAの変数addに代入されるセルをコピーしてブックBに貼り付けてました。するとどういうわけかすんなり動きました。
これで問題解決か？と思ったのですがさらに現在の私ではちょっと理解できない内容にあたりました。コピーされた文字列を編集して増やしたり減らしたりしてもちゃんと検索されます。(もちろんブックB内の貼り付け先のシートが変わってもです)では、やはりxlPartが適用されているということになります。
ブックAのセルとブックBのセルで何が違ったのか？それがわかりません。Matchcaseは省略しているのでFalseの条件のはずですし・・・。何か思い当たる事がありましたらアドバイスお願いします。
最悪、時間はかかりますがブックBの各シートのA列の内容を全部書き直して完全一致の内容にして対応してみようと思います。

回答No.4

n-jun

ANo.3です。

あとは実際のファイルにて検証してみないと何とも言えないですね。
何かの原因でデータが違うのか？
データが一致するかを総当たりで比較してみないと何とも。。。

お礼

やはりそうなりますよね(^^;)
最後までありがとうございました。

回答No.2

n-jun

Do～Loop内の
>Set findcell = Workbooks("B").Worksheets.(sh_no).Range("A:A").Find( _
>What:=add, _
>LookIn:=xlValues, _
>LookAt:=xlPart, _
>Searchorder:=xlByRows)
を
With Workbooks("B").Worksheets(sh_no)
Set findcell = .Range("A:A").Find( _
What:=Add, _
After:=.Range("A" & Rows.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
Searchorder:=xlByRows)
End With
としてみては？

補足

やはり無限ループです。
loop処理後のブックAをアクティブにするところに進まないところを見るとやはりLoop処理自体に欠陥があるとしか考えられないのですが、検索先のシート構成や構文構成を見ても大丈夫な気がしています。
先程試してなぜか分かりませんが、Doから2行下をIf Not fincell Is nothing Then としてみるとなぜか処理が進みloopを抜けます(笑)
ということは検索対象を見つけているということなのでしょうか？

回答No.1

n-jun

１回目のFindメソッドで見つかったセル番地が、２回目のFindメソッドの検索開始位置に影響している、
なんて事はないでしょうか。

検証していないので的はずれならすいません。

お礼

もしやと思いDo構文中のThisWorkbookをWorkbook("B")にしてみたところキーワードは見つからないままなのですが、エラーが出なくなりループが切れないでプロシージャが延々と実行中のままとなる状態になってしまいました。一応、全シート数をこえたら終了するようにしているつもりなのですが、これではまずいのでしょうか？

補足

After部分は省略しているので左上からしてくれていると思うのですがそうでないことってあるんでしょうか？
ためしにAfter:=Range("A1")も含めてみましたが特に変化はありませんでした（^^;）