無料VBA講座

　Sub ファイルを開かずに製番をFINDする()

　　Range("C5:D5").ClearContents 　　　　　' 抽出結果を消去
　　Range("B7").ClearContents
　　strSeib = Range("B5")　　　　　　　　　 ' B5に入力した製番を変数 strSeib に代入

　　Set appExcel = GetObject("E:\契約一覧.xls")
　　Set rangeR = appExcel.Worksheets("商品別").Range("H6:H100").Find(strSeib)
　　　　' この部分がファイルを開かないで、製番フィールドの中から strSeib と言う製番を見つけ出して
　　　　' rangeR に代入している。

　　If rangeR Is Nothing Then　　　　　　　 ' rangeR が空白ならメッセージを出して終了する。
　　　appExcel.Close
　　　Set sppExcel = Nothing
　　　Set rangeR = Nothing
　　　MsgBox "この製番は存在しません", vbInformation, "製番変更"
　　　Exit Sub
　　End If

　　If strSeib <> rangeR Then 　　　　　　' strSeib と rangeR が同じでなかったら終了する。
　　　appExcel.Close　　　　　　　　　　　
　　　Set sppExcel = Nothing
　　　Set rangeR = Nothing
　　　MsgBox "この製番は存在しません", vbInformation, "製番変更"
　　　Exit Sub
　　End If　
　　　' ●この部分は、製番NK-8239 を検索条件にしても、データの中にNK-8239Aと言う製番があれば
　　　　それが抽出されるので、ここで完全一致だけを抽出している。

　　intRow = rangeR.Row　　　　　　　　　　　　　　　　　　　　　' rangeRの行番号をintRowに代入
　　intkin = appExcel.Worksheets("商品別").Range("G" & intRow)
　　　　　　　　　　　　　　　　　　　　　' intRowに代入した行番号で、金額フィールドから金額を取得
　　strCod = appExcel.Worksheets("商品別").Range("B" & intRow)
　　　　　　　　　　　　　　　　　　　　　' intRowに代入した行番号で、商品コードフィールドから取得

　　Range("C5").Value = intkin　　　　　 ' 自分のファイルのC5に金額を記入
　　Range("D5").Value = intRow
　　Range("B7").Value = strCod '機種コード

　　appExcel.Close　　　　　　　　　　　 ' メモリに置いたファイルを開放している。
　　Set sppExcel = Nothing　　　　　　　' 変数を消している。
　　Set rangeR = Nothing
　End Sub

●このやり方は、メモリにファイルを置いて、開かずに操作するから処理は早いが、目視で着なくても
　ファイルは開いているもで、ネットワーク上のディスクに置いたときなどに、他のPCから「契約一覧.xls」
　を開こうとすると、読み取り専用になる。
　それを開放するのが Close である。