【VBA】他ブックからデータを取得

ブックを開いて取得(遅い)

'検索先ワークブックを開いて変数に格納
    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

ブックを開かないで値を取得する方法

ブックを開かない為、高速で値取得可能ですが以下は不可。
文字列検索などは取り込み後のデータに対して行う。

  • シート名検索はできない
  • 最終行検索もできない

選択したブックを開かずにリンクで値取得する

  1. ファイルダイアログでファイルを選択してファイルパスを取得 (FileDialog)
  2. ファイルパスをリンク形式に変換 (InStrRev, Left, Mid) \フォルダ1\Book1.xlsm
    ​ (リンク形式に変換) “=\\フォルダ1\[Book1.xlsm]シート1!A1”
  3. 書き込み先セル範囲に式を代入 (Range, Resize)
  4. 値で貼り付け直す (.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

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

CAPTCHA