[[20041111111656]]　『複数ファイルからのデータの抽出』（しろうと）　ページの最後に飛ぶ

『複数ファイルからのデータの抽出』（しろうと）

1つのファイルのシートの中にＡ社とＢ社の電話番号の一覧のシートがあります。
別のファイルににＡ社の電話番号と設置場所のシートがあります。
また別のファイルににＢ社の電話番号と設置場所のシートがあります。
Ａ社とＢ社を見分けるトリガーはないのですが
元のファイルの電話番号の列の次の列に設置場所を転記するのに
いい方法はないでしょうか？
レコード数は２０００くらいです。

 各ブックのシート名や、シート上のレイアウト、具体的なデータ例をお教え下さい。 
  (INA)

元ファイルには

　　　Ａ　

1 03xxxxxxx1

2 03xxxxxxx2

3 03yyyyyyy1

4 03yyyyyyy2

別ファイル（Ａ社）は

　　　Ａ　　　　　Ｂ

1 03xxxxxxx1　東京都渋谷区

2 03xxxxxxx2　東京都板橋区

3 03xxxxxxx3　東京都北区

4 03xxxxxxx4　東京都港区

別ファイル（Ｂ社）は

　　　Ａ　　　　　Ｂ

1 03yyyyyyy1　東京都新宿区

2 03yyyyyyy2　東京都世田谷区

3 03yyyyyyy3　東京都荒川区

4 03yyyyyyy4　東京都品川区

で、完成させたいものは、元ファイルを

　　　Ａ　　　　　　Ｂ　

1 03xxxxxxx1　東京都渋谷区

2 03xxxxxxx2　東京都板橋区

3 03yyyyyyy1　東京都新宿区

4 03yyyyyyy2　東京都世田谷区

みたいなかんじです。

元ファイルは1000レコード、Ａ社は2000レコード　Ｂ社は500レコードあります。
（しろうと）

 マクロ作るしかないかな・・
  (INA)

 別ファイルＡ社のデータと別ファイルＢ社のデータをひとつのシートにコピーして、
 後は VLOOKUP関数で引っ張ればいいのではないかな？ はずしてたらすみません。（純丸）

 数式で出来るのか・・・(*_*)

 Sub sample()
 Dim wb As Workbook, wb1 As Workbook, wb2 As Workbook
 Dim wbPath As String
 Dim i As Long
 Dim r As Range

    MsgBox "もとブックを開いて下さい。"
    wbPath = Application.GetOpenFilename("Excelファイル (*.xls), *.xls", , "もとブックを開いて下さい。")
    If wbPath = "False" Then Exit Sub
    Set wb = Workbooks.Open(wbPath)

    MsgBox "Ａブックを開いて下さい。"
    wbPath = Application.GetOpenFilename("Excelファイル (*.xls), *.xls", , "Ａブックを開いて下さい。")
    If wbPath = "False" Then Exit Sub
    Set wb1 = Workbooks.Open(wbPath)

    MsgBox "Ｂブックを開いて下さい。"
    wbPath = Application.GetOpenFilename("Excelファイル (*.xls), *.xls", , "Ｂブックを開いて下さい。")
    If wbPath = "False" Then Exit Sub
    Set wb2 = Workbooks.Open(wbPath)

    With wb.Worksheets(1)

        .Activate

        For i = 1 To .Range("a65536").End(xlUp).Row
            Set r = wb1.Worksheets(1).Range("A:A").Find(.Cells(i, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)

            If r Is Nothing Then
                Set r = wb2.Worksheets(1).Range("A:A").Find(.Cells(i, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
            End If

            If Not r Is Nothing Then
                .Cells(i, 2).Value = r.Offset(, 1).Value
            End If

        Next i
    End With

    wb1.Close False
    wb2.Close False
    MsgBox "完了"
 End Sub

   (INA)

INAさま
ありがとうございます！
（しろうと）

コメント返信：

[ 一覧(最新更新順) ]

[[20041111111656]] 『複数ファイルからのデータの抽出』（しろうと） ページの最後に飛ぶ

[[20041111111656]]　『複数ファイルからのデータの抽出』（しろうと）　ページの最後に飛ぶ