人に聞けない痔の悩み、これでスッキリ >>

一覧表というBookがあります
№ タイトル  店番  種類  コード①  コード②  コード③
1  aaaaaaa  (空欄)  AA   (空欄)   (空欄)   (空欄)
2 bbbbbbb   〃   BB    〃     〃     〃
3  ・
4  ・
5  ・
この様な表になっています
別の集約表というBookに
タイトル  店番 コード② コード③ コード①
cccccccc   25   5.26  3.33     4.44
bbbbbbb   -     -     -     -
sssssssss 45   8.45    6.55   8.88
aaaaaaaa 88   7.65    8.15   3.77
mmmmm
タイトルは同じなのですが、順番がバラバラになっています

集約表の店番、コード①②③の4つを一覧表に転記したいのですが・・・
20000件以上のデータがある為、マクロを使用して自動転記を行いたいのです
マクロの登録は集約表か別の新しいBookに登録したいです。


初心者のため細かいマクロの記述が出来ず申し訳ありませんが
出来れば詳しく教えて頂けないでしょうか
よろしくお願いいたします。

このQ&Aに関連する最新のQ&A

A 回答 (1件)

こんばんは!



↓の画像のような配置で
元データは「集約表」Bookの「Sheet1」にあるとし、「一覧表」BookのSheet1に表示させるとします。

>20000件以上のデータがある為・・・
とは「一覧表」Bookの方になるのでしょうか?

そうであればループさせるようにしていますので、結構時間がかかると思います。

一例です。「一覧表」Bookの標準モジュールにしてください。
尚、「集約表」Bookが開いていない場合は開くところからやっています。

Sub Sample1()
Dim i As Long, c As Range
Dim myPath As String, fN As String
Dim wB As Workbook, wS As Worksheet
myPath = "保存場所のパス" & "\"
fN = "集約表.xlsx"
Application.ScreenUpdating = False
'▼集約表Bookが開いていない場合は開く//
If Workbooks.Count = 1 Then
Workbooks.Open myPath & fN
End If
Set wB = Workbooks(fN)
Set wS = wB.Worksheets("Sheet1")
With ThisWorkbook.Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
Set c = wS.Range("A:A").Find(what:=.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Cells(i, "C") = wS.Cells(c.Row, "B")
.Cells(i, "E") = wS.Cells(c.Row, "E")
.Cells(i, "F") = wS.Cells(c.Row, "C")
.Cells(i, "G") = wS.Cells(i, "D")
End If
Next i
Application.ScreenUpdating = True
.Activate
End With
MsgBox "完了"
End Sub

※ コード内の「保存場所のパス」の部分は
実際のパスにしてください。
保存場所のファイル上で右クリック → プロパティ で確認してください。m(_ _)m
「VBA 別ブックから該当データを検索し、」の回答画像1
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
思ってた通りの形に出来ました!
とても助かりました。

お礼日時:2016/12/18 19:47

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング