■VBAマクロでワークブックAにワークブックBの集計をしたい。

■VBAマクロでワークブックAにワークブックBの集計をしたい。

ただし、ワークブックBは同じ番号で何個もあり、日付も並んでいません。
またワークブックAにあってBにない番号、また逆もあります。
それを日付が近いものから3つまで表示。


例）
ワークブックA　（sheet1)
　番号　メモA１　　メモA2　メモB1　　メモB2　メモC1　メモC3
11111　2010/7/7　 ccc　2010/5/5　ddd　2010/3/3　bbb
22222　2010/10/10 fff　2010/2/2　eee
35851　2010/12/12 ggg
54321

ワークブックB (sheet1)
番号　　日付　　メモ
11111　2009/1/1　aaa
11111　2010/3/3　bbb
11111　2010/7/7　ccc
11111　2010/5/5　ddd
22222　2010/2/2　eee
23568 2010/4/4 hhh
22222 2010/10/10 fff
35851 2010/12/12 ggg

※ワークブックAは最初項目と番号以外メモ部分は白紙です。例）は実行後の結果です。

質問で足りない部分ありましたら補足を入れますのでよろしくお願い致しますｍ（＿＿）ｍ

No.1 ベストアンサー 回答者： nag0720 回答日時： 2010/10/19 17:56

ワークブックAのSheet1のシートモジュールに次のコードを書いてください。

Sub 集計()
Dim i As Integer
Dim j As Integer
Dim 番号 As String
Dim 日付 As Date
Dim メモ As String
For i = 2 To Workbooks("ワークブックB").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
番号 = Workbooks("ワークブックB").Sheets("Sheet1").Cells(i, 1).Value
日付 = Workbooks("ワークブックB").Sheets("Sheet1").Cells(i, 2).Value
メモ = Workbooks("ワークブックB").Sheets("Sheet1").Cells(i, 3).Value
For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(j, 1).Value = 番号 Then
If Cells(j, 2).Value < 日付 Then
Cells(j, 6).Value = Cells(j, 4).Value
Cells(j, 7).Value = Cells(j, 5).Value
Cells(j, 4).Value = Cells(j, 2).Value
Cells(j, 5).Value = Cells(j, 3).Value
Cells(j, 2).Value = 日付
Cells(j, 3).Value = メモ
ElseIf Cells(j, 4).Value < 日付 Then
Cells(j, 6).Value = Cells(j, 4).Value
Cells(j, 7).Value = Cells(j, 5).Value
Cells(j, 4).Value = 日付
Cells(j, 5).Value = メモ
ElseIf Cells(j, 6).Value < 日付 Then
Cells(j, 6).Value = 日付
Cells(j, 7).Value = メモ
End If
Exit For
End If
Next
Next
End Sub

この回答への補足

遅くなりましたが、ありがとうございました。

自分のファイルに置き換えができました＾＾

補足日時：2010/10/21 15:31

この回答へのお礼

ありがとうございます。
今、確認ができないので、ひとまずお礼をっ（＞＜；

お礼日時：2010/10/19 18:18