Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7851 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【36318】35行９列に仕上げる gako 06/3/28(火) 21:05 質問[未読]
【36320】Re:35行９列に仕上げる Kein 06/3/28(火) 21:46 回答[未読]
【36365】Re:35行９列に仕上げる gako 06/3/29(水) 22:44 お礼[未読]
【36366】Re:35行９列に仕上げる Kein 06/3/29(水) 23:00 回答[未読]
【36475】Re:35行９列に仕上げる gako 06/3/31(金) 23:15 お礼[未読]
【36321】Re:35行９列に仕上げる とおりすがり 06/3/28(火) 21:50 発言[未読]
【36318】35行９列に仕上げる
質問  gako  - 06/3/28(火) 21:05 -
引用なし
パスワード
   約100枚のシートの個人別積み立て表があります。
この100枚のシートの表を1枚の集計表に仕上げたいのです。

個々の積み立て表は次のような内容です。
　　　A 　　　B　　　　C　　　　D
1　コード　氏名
2　 001　　 AAA
3
4
5　日付　　備考　　金額　　合計　　　
6　1/31　　　　　　　　100　　　 300
7　2/28　　　　　　　　100
8　3/31　　　　　　　　100
9


集計表に集計するため次のようなコードを書いています。
このコードでは、集計表のAからC列(コード、氏名、金額）に100行にまたがりデータが張り込まれます。
Sub 集計 ()
Dim Ws as Worksheet
Dim LngR as long
　 For Each Ws In Worksheets
　　If Ws.Name<>集計表 And Ws.Name<>XYZ Then

　　 With Sheets("集計表")
　　　　LngR=.Range("A65536").End(xlUp).Offset(1).Row
　　　 .Range("A"&LngR)=Ws.Range("A2")
　　　 .Range("B"&LngR)=Ws.Range("B2")
　　　 .Range("C"&LngR)=Ws.Range("D6")
　　 End With

　　End If
　Next
End Sub


これを下のような表の『３５行９列の仕上げ』にしたいのですが、コードのチェックを
お願いできませんでしょうか。　

１　コード　氏名　合計　 | コード　氏名　 合計　　 ｜コード　氏名　合計
２　　001　　AAA　300 　｜036　　　aaa　　1000　　｜071　　　xxx　 1500
３　　002　　BBB　400 　｜　　　　　　　 　　　　　｜
：　 003　　CCC　700
：
35


　
【36320】Re:35行９列に仕上げる
回答  Kein  - 06/3/28(火) 21:46 -
引用なし
パスワード
   Sub 集計2()
　 Dim Ws As Worksheet
　 Dim Ary As Variant
　 Dim MyC As Integer

　 For Each Ws In Worksheets
　　　If Ws.Name <> "集計表" And Ws.Name <> "XYZ" Then
　　　　 Ary = Array(Ws.Range("A2").Value, _
　　　　 Ws.Range("B2").Value, Ws.Range("D4").Value)
　　　　 Select Case Val(Ary(0))
　　　　　　Case Is < 36: MyC = 1
　　　　　　Case Is < 71: MyC = 4
　　　　　　Case Else: MyC = 7
　　　　 End Select
　　　　 Sheets("集計表").Cells(65536, MyC).End(xlUp) _
　　　　 .Offset(1).Resize(, 3).Value = Ary
　　　　 Erase Ary
　　　End If
　 Next
End Sub

で、どうでしょーか ?
【36321】Re:35行９列に仕上げる
発言  とおりすがり  - 06/3/28(火) 21:50 -
引用なし
パスワード
   ▼gako さん：
>約100枚のシートの個人別積み立て表があります。
>この100枚のシートの表を1枚の集計表に仕上げたいのです。
>
>個々の積み立て表は次のような内容です。
>　　　A 　　　B　　　　C　　　　D
>1　コード　氏名
>2　 001　　 AAA
>3
>4
>5　日付　　備考　　金額　　合計　　　
>6　1/31　　　　　　　　100　　　 300
>7　2/28　　　　　　　　100
>8　3/31　　　　　　　　100
>9
>
>
>集計表に集計するため次のようなコードを書いています。
>このコードでは、集計表のAからC列(コード、氏名、金額）に100行にまたがりデータが張り込まれます。
>Sub 集計 ()
> Dim Ws as Worksheet
> Dim LngR as long
>　 For Each Ws In Worksheets
>　　If Ws.Name<>集計表 And Ws.Name<>XYZ Then
>
>　　 With Sheets("集計表")
>　　　　LngR=.Range("A65536").End(xlUp).Offset(1).Row
>　　　 .Range("A"&LngR)=Ws.Range("A2")
>　　　 .Range("B"&LngR)=Ws.Range("B2")
>　　　 .Range("C"&LngR)=Ws.Range("D6")
>　　 End With
>
>　　End If
>　Next
>End Sub
>
>
>これを下のような表の『３５行９列の仕上げ』にしたいのですが、コードのチェックを
>お願いできませんでしょうか。　
>
>１　コード　氏名　合計　 | コード　氏名　 合計　　 ｜コード　氏名　合計
>２　　001　　AAA　300 　｜036　　　aaa　　1000　　｜071　　　xxx　 1500
>３　　002　　BBB　400 　｜　　　　　　　 　　　　　｜
>：　 003　　CCC　700
>：
>35
>
>

なぜ自分でチェックできない？
100行にまたがりデータが張り込まれるって？
集計表シートに書き込んでるコードはたった３行しかないんだから、それぞれ書き込みをするときの変数をチェックすればいいでしょ？

それと、　If Ws.Name<>集計表 And Ws.Name<>XYZ Then
ここも　集計表とXYZはシート名の集計表とXYZじゃないから。
シート名の集計表とXYZにしたいなら、それぞれを””で括らないとダメ
【36365】Re:35行９列に仕上げる
お礼  gako  - 06/3/29(水) 22:44 -
引用なし
パスワード
   ▼Kein さん：

親切な回答を頂きありがとうございました。
勉強になりました。解決でき喜んでおります。

もし、時間がいただけるようでしたら…
36行目C,F,J列に合計を入れたいのですが、アドバイス
いただけませんでしょうか。
Range("A36,D36,G36") = "合計"
この後Subtotalを入れたいのですが…よろしくお願いします。
【36366】Re:35行９列に仕上げる
回答  Kein  - 06/3/29(水) 23:00 -
引用なし
パスワード
   Next の直下に

With Sheets("集計表")
　 .Range("A36, D36, G36").Value = "合計"
　 .Range("C36").Formula = "=SUM(C2:C35)"
　 .Range("F36").Formula = "=SUM(F2:F35)"
　 .Range("I36").Formula = "=SUM(I2:I35)"
End With

と、追加するだけです。
【36475】Re:35行９列に仕上げる
お礼  gako  - 06/3/31(金) 23:15 -
引用なし
パスワード
   ▼Kein さん：
>Next の直下に
>
>With Sheets("集計表")
>　 .Range("A36, D36, G36").Value = "合計"
>　 .Range("C36").Formula = "=SUM(C2:C35)"
>　 .Range("F36").Formula = "=SUM(F2:F35)"
>　 .Range("I36").Formula = "=SUM(I2:I35)"
>End With
>
>と、追加するだけです。

よく分かりました。ありがとうございます。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7851 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free