Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9371 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【27757】複数シートの集計 hisao 05/8/18(木) 10:25 質問[未読]
【27758】Re:複数シートの集計 Kein 05/8/18(木) 11:22 回答[未読]
【27765】Re:複数シートの集計 hisao 05/8/18(木) 16:36 お礼[未読]
【27757】複数シートの集計
質問  hisao E-MAIL  - 05/8/18(木) 10:25 -
引用なし
パスワード
   いつもお世話になります。
下記の様なシートが１０枚程度（数は不定ですが集計表以外を全て集計すると考えて結構です）有ります。
行数は不定、番号はランダムに並んでいます。

番号　　　　費目　　　　金額
2　　　　a　　　　100
5　　　　a　　　　200
6　　　　b　　　　300
4　　　　b　　　　70
2　　　　a　　　　50

この全てのシートを集計して下記の縦番号、横費目の集計表を作りたいのですが
配列など使って早く集計する方法を教えて下さい。
番号は500点,費目は5点程度です。

番号　　　　a　　　　b
1　　　　　　　　
2　　　　　　　　
3　　　　　　　　
4　　　　　　　　
5
【27758】Re:複数シートの集計
回答  Kein  - 05/8/18(木) 11:22 -
引用なし
パスワード
   まず予め「集計」という名前の新規シートを、挿入しておいて下さい。そして以下の
マクロを試してみて下さい。

Sub My集計()
　 Dim WS As Worksheet
　 Dim C As Range
　 Dim xR As Long
　 Dim MyC As Variant

　 On Error GoTo ELine
　 Set Sh = Worksheets("集計")
　 On Error GoTo 0
　 Sh.Cells.ClearContents
　 Sh.Range("A1").Value = "番号"
　 For Each WS In Worksheets
　　　If WS.Name = "集計" Then GoTo NLine
　　　For Each C In WS.Range("A2", WS.Range("A65536").End(xlUp))
　　　　 xR = C.Value
　　　　 MyC = Application _
　　　　 .Match(C.Offset(, 1).Value, Sh.Rows(1), 0)
　　　　 If IsError(MyC) Then
　　　　　　With Sh.Range("IV1").End(xlToLeft).Offset(, 1)
　　　　　　　 MyC = .Column
　　　　　　　 .Value = C.Offset(, 1).Value
　　　　　　End With
　　　　 End If
　　　　 Sh.Cells(xR, MyC).Value = _
　　　　 Sh.Cells(xR, MyC).Value + C.Offset(, 2).Value
　　　Next
NLine:
　 Next
　 Set Sh = Nothing: Exit Sub
ELine:
　 Worksheets.Add(After:=Worksheets(Worksheets.Count))
　 ActiveSheet.Name = "集計"
　 Resume Next
End Sub　
【27765】Re:複数シートの集計
お礼  hisao E-MAIL  - 05/8/18(木) 16:36 -
引用なし
パスワード
   ▼Kein さん：
有り難う御座いました。素晴らしいです。まだまだ私の勉強不足を感じました。

>まず予め「集計」という名前の新規シートを、挿入しておいて下さい。そして以下の
>マクロを試してみて下さい。
>
>Sub My集計()
>　 Dim WS As Worksheet
>　 Dim C As Range
>　 Dim xR As Long
>　 Dim MyC As Variant
>
>　 On Error GoTo ELine
>　 Set Sh = Worksheets("集計")
>　 On Error GoTo 0
>　 Sh.Cells.ClearContents
>　 Sh.Range("A1").Value = "番号"
>　 For Each WS In Worksheets
>　　　If WS.Name = "集計" Then GoTo NLine
>　　　For Each C In WS.Range("A2", WS.Range("A65536").End(xlUp))
>　　　　 xR = C.Value
>　　　　 MyC = Application _
>　　　　 .Match(C.Offset(, 1).Value, Sh.Rows(1), 0)
>　　　　 If IsError(MyC) Then
>　　　　　　With Sh.Range("IV1").End(xlToLeft).Offset(, 1)
>　　　　　　　 MyC = .Column
>　　　　　　　 .Value = C.Offset(, 1).Value
>　　　　　　End With
>　　　　 End If
>　　　　 Sh.Cells(xR, MyC).Value = _
>　　　　 Sh.Cells(xR, MyC).Value + C.Offset(, 2).Value
>　　　Next
>NLine:
>　 Next
>　 Set Sh = Nothing: Exit Sub
>ELine:
>　 Worksheets.Add(After:=Worksheets(Worksheets.Count))
>　 ActiveSheet.Name = "集計"
>　 Resume Next
>End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9371 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free