Eドライブにkeiyaku.xlsを置くには、この[Excel]
ボタンを押して、開いたファイルを保存する。

 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 である。
検索結果が抽出された。
プログラムをボタンに登録してあるので、B5に製番を記入してボタンを押せば抽出できる。
そのファイルの中から、製番で検索して、金額、商品コードとその書いてある行番号を取得する。
Eドライブに、keiyaku.xlsと言うファイルがある。
● 相手のファイルを開かずにFind検索してデータを取得する。
 
基本的なマクロの習得
相手のファイルを開かないでデータの Find検索


実際に使っているシステムの内容で解説
  EXCEL VBA 講座