ブックを開いて取得(遅い)
'検索先ワークブックを開いて変数に格納
Dim wb As Workbook
Set wb = Workbooks.Open(FileName:="ファイルパス", ReadOnly:=True)
Dim ws As Worksheet
Set ws = wb.Sheets("シート名")
'開いたブックを保存しないで閉じる
wb.Close (False)
ブックを開かないで取得(速い)
'他ブックリンク式を代入(最終行検索は不可の為、セル範囲指定で取得する)
With ws.Range("A1:L500")
.Value = "='\\フォルダパス\[エクセルファイル名.xls]シート名'!A1"
.Value = .Value 'リンクを値に変換
End With
ブックを開かないで値を取得する方法
ブックを開かない為、高速で値取得可能ですが以下は不可。
文字列検索などは取り込み後のデータに対して行う。
- シート名検索はできない
- 最終行検索もできない
選択したブックを開かずにリンクで値取得する
- ファイルダイアログでファイルを選択してファイルパスを取得 (FileDialog)
- ファイルパスをリンク形式に変換 (InStrRev, Left, Mid) \フォルダ1\Book1.xlsm
(リンク形式に変換) “=\\フォルダ1\[Book1.xlsm]シート1!A1” - 書き込み先セル範囲に式を代入 (Range, Resize)
- 値で貼り付け直す (.Value = .Value)
'選択したブックの値を取得する場合
Dim FileName As String '選択したファイルパス格納変数
'ファイルダイアログからファイルを選択してファイルパスを取得
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.Filters.Add "Excelマクロ有効", "*.xlsm"
.InitialFileName = "最初に開くフォルダパス"
.AllowMultiSelect = False
If .Show = True Then '選択された場合
FileName = .SelectedItems(1) 'ファイルパスを変数に格納
Else '選択されなかった場合
MsgBox "キャンセルしました"
End
End If
End With
'ファイルパス名を文字列検索して「\」が何文字目にあるか見つける(後ろから検索)
Dim num As Long
num = InStrRev(FileName, "\")
'先頭に"='"、\の後ろに"["、最後に"]シート名'!A1"を挿入
Dim LinkName As String
LinkName = "='" & Left(FileName, num) & "[" & Mid(FileName, num + 1) & "]シート名'!A1"
'リンク式をセル範囲に代入
Dim rng As Range
Set rng = Target.Cells(1, 1).Offset(2, 0).Resize(183, 12)
rng = LinkName
'リンクを値に変換する
rng.Value = rng.Value
スポンサーリンク