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列に空白があるためかと思い埋めてみましたが関係ないようです。
構文エラー的なものは無いと思いますが、宜しくお願いします。
お礼
ヘルプは真っ先に見て、参考にしてみたのですがわかりませんでした。 Rangeを返すから、当然変数もRangeになりますね。 そうだよなぁと気づきました。再度考えます。 ご回答、ありがとうございます。