|
▼BON さん:
ponponです。こんばんは。
>
>具体的には、部品表一覧のシートがあるEXCELファイル(仮にA)がありまして、
>一覧として、部品番号、部品名、型番、納入日が並んでます。
>
>そこに、必要とする部品名のみが並んでいる別のEXCELファイル(仮にB)が
>ありまして、部品名に該当する一覧表(A)の行を取得して、別のEXCELファイル
>(仮にC)の定型シートに取得した部品番号、部品名、型番、納入日を
>セットしたいというものです。
>
>この内容で教えて頂きたいと思っていることは、
>・Bの部品名に該当するAの部品番号、部品名、型番、納入日の
> 取得方法
>です。
>部品名で検索して、部品名に合致した行の部品番号の取得方法でも
>結構です。
>
>市販本を読んでいますが、実用に近い実例がなく、苦慮しております。
>どなたか、お知恵を拝借できないものでしょうか。
初心者につき、できるにはできたのですが、もっとスマートな方法があると思います。
前提条件
workbookのA、B、Cは、開いていてください。
Aのsheet1の1行目は、部品番号、部品名、型番、納入日の項目。2行目からデータ
Bのsheet1のA列に1行目は、部品名の項目、2行目からデータ
Cのsheet1の1行目は、Aの1行目と同じ項目があるものとする。
A、B、C、どの標準モジュールにコピペしても動くと思います。
以下コードです。
Sub test()
Dim myRng As Range
Dim myVal As Variant
Dim r As Range
Application.ScreenUpdating = False
Workbooks("A.xls").Activate
Set myRng = Workbooks("A.xls").Sheets(1).Range(Range("B2"), _
Range("B65536").End(xlUp))
Workbooks("B.xls").Activate
myVal = Workbooks("B.xls").Sheets(1).Range(Range("A2"), _
Range("A65536").End(xlUp)).Value
For i = 1 To UBound(myVal)
On Error Resume Next
Workbooks("A.xls").Activate
Set r = myRng.Find(what:=myVal(i, 1), lookat:=xlWhole)
r.Offset(, -1).Resize(1, 4).Copy
Workbooks("C.xls").Activate
Workbooks("C.xls").Sheets(1).Range("A65536").End(xlUp) _
.Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
On Error GoTo 0
Next
Application.ScreenUpdating = True
End Sub
もう一つ今度はフィルターを使って
前提条件は、上と同じですが、
Cのsheet1は何もないでもokです。
Sub test2()
Dim myData As Range
Dim myRng As Range
Workbooks("B.xls").Activate
Set myRng = Workbooks("B.xls").Sheets(1).Range(Range("A1"), _
Range("A65536").End(xlUp))
Workbooks("A.xls").Activate
Set myData = Workbooks("A.xls").Sheets(1).Range(Range("B1"), _
Range("B65536").End(xlUp))
myData.AdvancedFilter xlFilterInPlace, myRng
Workbooks("A.xls").Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("C.xls").Activate
Workbooks("C.xls").Sheets(1).Range("A1").PasteSpecial
Application.CutCopyMode = False
Workbooks("A.xls").Activate
Workbooks("A.xls").Sheets(1).ShowAllData
End Sub
|
|