出産前後の痔にはご注意!

別ファイルから一致する項目を探し、
一致していれば抜き出しをする方法が
わかる方いましたらよろしくお願いいたします。

ファイル① シート①
A B C
ab01 2000 りんご
ab09 1500 ぶどう

ファイル① シート②
A B C
ac07 1300 りんご
ac13 1600 みかん

ファイル① シート③
A B C
ad25 2000 みかん
ad12 1600 ぶどう

ファイル②
A B C
ab01 3600 ぶどう
ab02 2100 みかん
ac13 1200 りんご
ac15 1500 りんご
ad01 1000 みかん
ad09 1500 ぶどう

このようなデータがあって、
ファイル②のA列の値が、
ファイル①のA列同じ数字があれば
ファイル②の値を全て抜き出す。
この場合だと、
ab01 3600 ぶどう
ac13 1200 りんご

B列 C列は一致していません。
ファイル①は各シートごとに頭の文字が一緒です。


初めはファイル②のD列に関数使って
一致と表示してフィルタでやろうかと思いましたが、
それも私の技量ではできず…
別シートに抜き出せるとベストなのですが、
わかる方いましたらご教授ください。

質問者からの補足コメント

  • うれしい

    ご回答ありがとうございます。
    補足いたします。
    ⑴管理番号付属実績
    ⑵受注管理
    ⑶①仙台支店②福岡支店③名古屋支店
    ⑷なにも入っていません。二行目からデータが入っているだけです。
    ⑸シート1
    ⑹28年実績照会
    ⑺検証結果というファイルに、①はそのままエクセルで。②は検証結果-実績確認ファイルの中にはいっています。
    ⑻よろしくお願いいたします。

    以上、お手数ですがよろしくお願いいたします。

    No.1の回答に寄せられた補足コメントです。 補足日時:2016/12/10 04:26

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

A 回答 (4件)

"受注管理"の標準モジュールに以下のマクロを登録してください。


登録後、保存する場合は、拡張子がxlsmになるので、ファイル名は"受注管理.xlsm"になります。
-----------------------------------------
Option Explicit
Public Const trgBook As String = "管理番号付属実績.xlsx"
Public Const mainBook As String = "受注管理.xlsm"
Public Sub 受注実績集計()
Dim mydic As Object
Dim sheets As Variant
Dim mainSheets As Variant
Dim i As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxRow1 As Long
Dim row1 As Long
Dim row2 As Long
Dim key As String
If IsOpenWorkBook(trgBook) = False Then
MsgBox (trgBook & "がオープンされていません。処理を中止します。")
Exit Sub
End If
Set mydic = CreateObject("Scripting.Dictionary")
sheets = Array("仙台支店", "福岡支店", "名古屋支店")
'管理番号付属実績を処理
Workbooks(trgBook).Activate
For i = 0 To UBound(sheets)
If ExistsWorkSheet(sheets(i)) = False Then
MsgBox (sheets(i) & "が存在しません。処理を中止します。")
Exit Sub
End If
Call chumon_shukei(sheets(i), mydic)
Next
'受注管理を処理
Workbooks(mainBook).Activate
mainSheets = Array("Sheet1", "28年実績照会")
'ワークシートの存在チェック
For i = 0 To UBound(mainSheets)
If ExistsWorkSheet(mainSheets(i)) = False Then
MsgBox (mainSheets(i) & "が存在しません。処理を中止します。")
Exit Sub
End If
Next
Set sh1 = Worksheets(mainSheets(0))
Set sh2 = Worksheets(mainSheets(1))
sh2.Cells.Clear '実績照会のクリア
maxRow1 = sh1.Cells(Rows.Count, 1).End(xlUp).row ' Sheet1の最終行を求める
row2 = 2
'Sheet1を2~最終行まで繰り返す
For row1 = 2 To maxRow1
key = sh1.Cells(row1, 1).Value
If mydic.exists(key) Then
sh1.Rows(row1).Copy (sh2.Rows(row2))
row2 = row2 + 1
End If
Next
MsgBox ("処理終了")
End Sub
'注文の集計
Private Sub chumon_shukei(ByVal sheetname As Variant, ByVal mydic As Object)
Dim sh As Worksheet
Dim maxrow As Long
Dim row As Long
Dim key As String
Set sh = Worksheets(sheetname)
maxrow = sh.Cells(Rows.Count, 1).End(xlUp).row ' 最終行を求める
For row = 2 To maxrow
key = sh.Cells(row, 1).Value
mydic(key) = True
Next
End Sub
'ワークブックのオープンチェック
Private Function IsOpenWorkBook(ByVal bookName As String) As Boolean
IsOpenWorkBook = False
Dim wk As Workbook
For Each wk In Workbooks
If wk.Name = bookName Then
IsOpenWorkBook = True
Exit Function
End If
Next
End Function

'ワークシートの存在チェック
Public Function ExistsWorkSheet(ByVal sheetname As String) As Boolean
Dim ws As Worksheet
ExistsWorkSheet = False
For Each ws In Worksheets
If ws.Name = sheetname Then
ExistsWorkSheet = True
Exit Function
End If
Next ws
End Function
----------------------------------------------
マクロ実行時は、"管理番号付属実績.xlsx"(管理番号付属実績.xlsmではありません)をオープンした状態で、
マクロ「受注実績集計」を実行してください。
以下の前提で作成しています。
ファイル①:管理番号付属実績.xlsx
シート①:仙台支店
シート②:福岡支店
シート③:名古屋支店
ファイル②:受注管理.xlsm
シート①:Sheet1 ・・・・データのあるシート名
シート②:28年実績照会 ・・・・空のシート(ここへ作成)

上記のファイル、シートがない場合はエラーになります。(28年実績照会も空のシートを作っておいてください)
    • good
    • 0

「各シートの見出し行は空白」とのことですが、それなりの名称を設定しましょう(全シート同じ見出しにしてください)。


それが可能であれば、こんな感じで行けると思います。
ファイル②の標準モジュールに下記のマクロを張り付けて下さい。
ちなみに、下記コード中のBook1、Book2、および、SheetXは、alluvさんの環境に合わせて修正が必要です。

Sub Macro1()
Dim wbMoto As Workbook
Dim wsSaki As Worksheet
Set wbMoto = Workbooks("Book1")
Set wsSaki = Workbooks("Book2").Sheets("Sheet1")
wbMoto.Sheets("Sheet1").Copy After:=wsSaki.Parent.Sheets(wsSaki.Parent.Sheets.Count)
With ActiveSheet
wbMoto.Sheets("Sheet2").UsedRange.Copy _
Destination:=.Cells(Rows.Count, "A").End(xlUp).Offset(1)
wbMoto.Sheets("Sheet3").UsedRange.Copy _
Destination:=.Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Range("A:C").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsSaki.Range("A1:A" & wsSaki.Range("A1").End(xlDown).Row), _
CopyToRange:=.Range("D1"), Unique:=False
.Columns("A:C").Delete Shift:=xlToLeft
End With
End Sub
    • good
    • 2

丸ごとコピーし「リンク貼り付け」したものにフィルタを掛ければ良いような気がする。

    • good
    • 0

いくつか質問があります。


1)ファイル①のファイル名は、何でしょうか。
2)ファイル②のファイル名は、何でしょうか。
3)ファイル①のシート①②③のシート名は何でしょうか。
4)ファイル①②とも見出しの有無はどうなっていますか。(1行目は見出しですか、データですか)
5)ファイル②のデータのあるシート名はなんですか。
6)別シートに抜き出すのは、ファイル②の別シートで良いですか。その場合、シート名はどうしますか。
7)二つのファイル①②は、同じフォルダ内にありますか。
8)マクロで実行しても良いですか。
この回答への補足あり
    • good
    • 0

このQ&Aに関連する人気のQ&A

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


人気Q&Aランキング