Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10254 / 13644 ツリー ←次へ | 前へ→

【22852】参照した行の情報をセットするには? BON 05/3/4(金) 23:41 質問[未読]
【22861】Re:参照した行の情報をセットするには? G-Luck 05/3/5(土) 10:45 発言[未読]
【22891】Re:参照した行の情報をセットするには? BON 05/3/6(日) 12:44 お礼[未読]
【22887】Re:参照した行の情報をセットするには? ponpon 05/3/5(土) 23:41 回答[未読]
【22890】Re:参照した行の情報をセットするには? BON 05/3/6(日) 12:41 お礼[未読]

【22852】参照した行の情報をセットするには?
質問  BON  - 05/3/4(金) 23:41 -

引用なし
パスワード
   初めて投稿します。
現在、初級の市販本を購入して毎日奮闘しております。
内容は、部品表なるものを作成しようとしています。

具体的には、部品表一覧のシートがあるEXCELファイル(仮にA)がありまして、
一覧として、部品番号、部品名、型番、納入日が並んでます。

そこに、必要とする部品名のみが並んでいる別のEXCELファイル(仮にB)が
ありまして、部品名に該当する一覧表(A)の行を取得して、別のEXCELファイル
(仮にC)の定型シートに取得した部品番号、部品名、型番、納入日を
セットしたいというものです。

この内容で教えて頂きたいと思っていることは、
・Bの部品名に該当するAの部品番号、部品名、型番、納入日の
 取得方法
です。
部品名で検索して、部品名に合致した行の部品番号の取得方法でも
結構です。

市販本を読んでいますが、実用に近い実例がなく、苦慮しております。
どなたか、お知恵を拝借できないものでしょうか。

【22861】Re:参照した行の情報をセットするには?
発言  G-Luck  - 05/3/5(土) 10:45 -

引用なし
パスワード
   ▼BON さん:

Range("A:A")でA列が取得できます。
Range("A:A").Cell(n) でA列のn番目のセルが取得できます。

シートAの部品名列とシートBの部品名列をセル単位で順次比較して、一致したものをコピーしてはどうですか?

適時、〜.Selectとして、動作を確認して進めてみてください。

【22887】Re:参照した行の情報をセットするには?
回答  ponpon  - 05/3/5(土) 23:41 -

引用なし
パスワード
   ▼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

【22890】Re:参照した行の情報をセットするには?
お礼  BON  - 05/3/6(日) 12:41 -

引用なし
パスワード
   ponponさん:
 BONです。
 事例を頂き、ありがとうございます。
 早速、チャレンジしてみます。

【22891】Re:参照した行の情報をセットするには?
お礼  BON  - 05/3/6(日) 12:44 -

引用なし
パスワード
   G-Luckさん:
 事例ありがとうございまた。
 現在、チャレンジしています。
 

10254 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free