Excel VBA質問箱 IV

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

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


2117 / 13645 ツリー ←次へ | 前へ→

【69803】複数のExcelの情報を一つのExcelに集約 かん 11/8/31(水) 1:09 質問[未読]
【69860】Re:複数のExcelの情報を一つのExcelに集約 UO3 11/9/6(火) 13:11 回答[未読]

【69803】複数のExcelの情報を一つのExcelに集約
質問  かん  - 11/8/31(水) 1:09 -

引用なし
パスワード
   はじめまして。突然で申し訳ないのですが、どなたか下記についてご教示頂ければ幸いです。

現在、一つのbookを複数のbookに分割し、分割したbookに情報を入力、当該情報を元のbookにコピペする、というマクロを作ろうと考えています。

具体的には、以下のような場合の処理になります。

≪前提≫
元のExcelをbook Aとした場合、book AのA1〜A100に1〜100の番号を振り、B1〜B33にX、B34〜B66にY、B67〜B100にZと入力。
その後、別のbook XのA1〜B33にbook AのA1〜B33を、book YのA1〜B33にbook AのA34〜B66を、book ZのA1〜B34にbook AのA67〜B100をそれぞれコピペ。
その後、book XのC1〜C33に文字で情報を入力。同様にしてbook YのC1〜C33、book ZのC1〜C34についても情報を入力。
こうして、元となるbook Aに、book Aをbook AのB列に従って分割し、C列に情報を入力したbook X、Y、Zの4種類のファイルが完成。

≪マクロで処理したい部分≫
book AのA列とbook X、Y、ZのA列はそれぞれ番号で紐づけられています。
そこで、A列の番号に従い、book AのC1〜C100に、book X、Y、ZのC列の対応する情報をコピペしたいのです。
言い換えると、book AのA列で1と番号が振られている場合は、book X、Y、ZのA列を検索し、1と番号が振られている行のC列をコピー、その後book AのC列にペーストする、この動作をbook AのA列の番号1〜100全てについて行いたいと考えています。

このような処理はどのように組めば良いのでしょうか。
どなたか教えて頂ければ非常に助かります。
使用しているのはExcel2003です。
よろしくお願いします。

【69860】Re:複数のExcelの情報を一つのExcelに集約
回答  UO3  - 11/9/6(火) 13:11 -

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

こんにちは

なぜかレスがつきませんね。

例としてアップされたものは、あくまで例ですよね。
このままなら、単に、BookX,Y,ZのC列をBookAにコピペすればいいことになりますから
ロジックというほどのものじゃないわけですよね。

なので、あくまで、BookX,Y,Z の A列に紐つけ番号があって、それは必ずしも連番じゃなく
また、まとまってもいない。で、BookA の その紐付け番号該当行のC列に値を転記。

また、必ずしも、行数は100行とか、そのなかで最初の33行がどうこうというわけでは
ないんですよね。

と、勝手に推測して。BookA,X,Y,Z が全て開かれているという前提で。

Sub Sample()
  Dim dic As Object
  Dim v As Variant
  Dim i As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  
  Call SetDic(dic, Workbooks("BookX.xls").Sheets("Sheet1")) 'シート名は実際のものを
  Call SetDic(dic, Workbooks("BookY.xls").Sheets("Sheet1")) 'シート名は実際のものを
  Call SetDic(dic, Workbooks("BookZ.xls").Sheets("Sheet1")) 'シート名は実際のものを
  
  With Workbooks("BookA.xls").Worksheets("Sheet1")     'シート名は実際のものを
    v = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    For i = 1 To UBound(v, 1)
      v(i, 3) = dic(v(i, 1))
    Next
    .Range("C1").Resize(UBound(v, 1)).Value = WorksheetFunction.Index(v, 0, 3)
  End With
  
  Set dic = Nothing
  
End Sub

Private Sub SetDic(dic As Object, sh As Worksheet)
  Dim c As Range
  
  With sh
    For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
      dic(c.Value) = c.Offset(, 2).Value
    Next
  End With
  
End Sub

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