| |
▼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の１行目は、Aの１行目と同じ項目があるものとする。
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
