Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

66295 / 76734

←次へ　｜　前へ→


	【15004】Re:集計表の作成について

Hirofumi - 04/6/13(日) 9:47 -


	引用なし

	パスワード

以下の様な形にするだけで善いのですね？

Sheet1　
　　　　A　　　　B　　　　C　　　　D　　　　E
1　　　　課名　　　　費目　　　　4月　　　　5月　　　　6月　
2　　　　1課　　　　▲　　　　1　　　　4　　　　9
3　　　　1課　　　　△　　　　3　　　　2　　　　11
4　　　　2課　　　　▲　　　　8　　　　6　　　　10
5　　　　2課　　　　△　　　　7　　　　5　　　　0

Sheet2
　　　　A　　　　B　　　　C　　　　D　　　　E　　　　F　　　　G
1　　　　　　　　4月　　　　　　　　5月　　　　　　　　6月
2　　　　課名　　　　▲　　　　△　　　　▲　　　　△　　　　▲　　　　△
3　　　　1課　　　　1　　　　3　　　　4　　　　2　　　　9　　　　11
4　　　　2課　　　　8　　　　7　　　　6　　　　5　　　　10　　　　0

以下を標準モジュールに記述して下さい

Option Explicit

Public Sub AddUp()

　　Dim i As Long
　　Dim rngData As Range
　　Dim lngRow As Long
　　Dim lngCol As Long
　　Dim rngResult As Range
　　
　　'結果表の左上セル位置を設定
　　Set rngResult _
　　　　= Worksheets("Sheet2").Cells(1, "A")
　　'データ表の左上セル位置を設定
　　Set rngData _
　　　　= Worksheets("Sheet1").Cells(1, "A")
　　
　　'データ表に就いて
　　With rngData
　　　　'月列の数を取得
　　　　lngCol = .End(xlToRight).Column _
　　　　　　　　　　　　- .Offset(, 2).Column
　　　　'データ行数を取得
　　　　lngRow = .Offset(, 1).End(xlDown).Row _
　　　　　　　　　　　　　　- .Offset(, 1).Row
　　End With
　　
　　'行見だしを作成
　　WriteRowTitle rngData, rngResult, lngRow
　　
　　'月の列の先頭から最後まで繰り返し
　　For i = 0 To lngCol
　　　　'月別に集計
　　　　ListWrite i, rngData, rngResult, lngRow
　　Next i
　　
　　Set rngData = Nothing
　　Set rngResult = Nothing

　　Beep
　　MsgBox "処理が完了しました"
　　
End Sub

Private Sub ListWrite(lngRead As Long, _
　　　　　　　　　　　　rngData As Range, _
　　　　　　　　　　　　rngResult As Range, _
　　　　　　　　　　　　lngRow As Long)

　　Dim i As Long
　　Dim vntData As Variant
　　Dim vntResult As Variant
　　
　　'出力用配列を確保
　　ReDim vntResult(0 To lngRow \ 2 + 1, 0 To 1)
　　'データ表の左上セルに就いて
　　With rngData
　　　　'データを配列に取得
　　　　vntData _
　　　　　　= .Offset(1, _
　　　　　　　　lngRead + 2).Resize(lngRow).Value
　　　　'月名を出力用配列に代入
　　　　vntResult(0, 0) _
　　　　　　　　= .Offset(, lngRead + 2).Value
　　　　'▲を出力用配列に代入
　　　　vntResult(1, 0) = .Offset(1, 1).Value
　　　　'△を出力用配列に代入
　　　　vntResult(1, 1) = .Offset(2, 1).Value
　　End With
　　
　　'データを出力用配列に書き込み
　　For i = 1 To UBound(vntData)
　　　　vntResult((i - 1) \ 2 + 2, (i - 1) Mod 2) _
　　　　　　　　　　　　　　　　　　= vntData(i, 1)
　　Next i
　　
　　'出力用配列を出力
　　With rngResult.Offset(, lngRead * 2 + 1)
　　　　.Resize(lngRow \ 2 + 2, 2).Value = vntResult
　　End With
　　
End Sub

Private Sub WriteRowTitle(rngData As Range, _
　　　　　　　　　　　　rngResult As Range, _
　　　　　　　　　　　　lngRow As Long)
　　
　　Dim i As Long
　　Dim vntData As Variant
　　Dim vntResult As Variant
　　
　　'出力用配列を確保
　　ReDim vntResult(0 To lngRow \ 2 + 1, 0 To 0)
　　'データ表の左上セルに就いて
　　With rngData
　　　　'データを配列に取得
　　　　vntData = .Resize(lngRow + 1).Value
　　End With
　　
　　'課名を出力用配列に代入
　　vntResult(1, 0) = vntData(1, 1)
　　'課を出力用配列に代入
　　For i = 2 To UBound(vntData) Step 2
　　　　vntResult(i \ 2 + 1, 0) = vntData(i, 1)
　　Next i
　　
　　'出力用配列を出力
　　With rngResult
　　　　.Resize(lngRow \ 2 + 2).Value = vntResult
　　End With
　　
End Sub

2 hits

▼

【15001】集計表の作成について 美咲 04/6/13(日) 1:42