Excel VBA質問箱 IV

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

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


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

10919 / 76734

←次へ　｜　前へ→


	【71358】Re:ソート→集計をマクロで

Hirofumi - 12/2/24(金) 19:40 -


	引用なし

	パスワード

こんなのでは？
「コード」で整列して、1行づつ処理しています

Option Explicit

Public Sub Sample_1()

　　'Listの列数（A～F列）
　　Const clngColumns As Long = 6
　　'Listの中の「コード」と成る列位置(基準列からの列Offset：0列目)
　　Const clngKey1 As Long = 0
　　
　　Dim i As Long
　　Dim lngRows As Long
　　Dim lngWrite As Long
　　Dim rngList As Range
　　Dim rngResult As Range
　　Dim vntData As Variant
　　Dim vntSum As Variant
　　Dim vntTotal As Variant
　　Dim strProm As String

　　'【集計】の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
　　Set rngList = Worksheets("集計").Range("A1")

　　'【合計集計】の結果出力の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
　　Set rngResult = Worksheets("合計集計").Range("A1")
　　
　　'画面更新を停止
　　Application.ScreenUpdating = False
　　
　　'【集計】のListに就いて
　　With rngList
　　　　'行数の取得
　　　　lngRows = .Offset(Rows.Count - .Row, clngKey1).End(xlUp).Row - .Row
　　　　If lngRows <= 0 Then
　　　　　　strProm = "データが有りません"
　　　　　　GoTo Wayout
　　　　End If
　　　　'Listを「コード」順で整列
　　　　.Offset(1).Resize(lngRows, clngColumns).Sort _
　　　　　　　　Key1:=.Offset(1, clngKey1), Order1:=xlAscending, _
　　　　　　　　Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
　　　　　　　　Orientation:=xlTopToBottom, SortMethod:=xlStroke
　　End With
　　
　　'【合計集計】に就いて
　　With rngResult
　　　　'データをクリア
　　　　If .CurrentRegion.Rows.Count > 1 Then
　　　　　　Intersect(.CurrentRegion, .CurrentRegion.Offset(1)).ClearContents
　　　　End If
　　End With
　　
　　'合計用の配列を確保
　　ReDim vntTotal(1 To clngColumns)
　　vntTotal(1) = "合計"
　　
　　'【集計】のデータ先頭行を集計用配列に取得
　　vntSum = rngList.Offset(1).Resize(, clngColumns).Value
　　'【集計】のデータ2行目～最終行+1まで繰り返し
　　For i = 2 To lngRows + 1
　　　　'1行分のデータを配列に取得
　　　　vntData = rngList.Offset(i).Resize(, clngColumns).Value
　　　　'「コード」が同じなら
　　　　If vntData(1, clngKey1 + 1) = vntSum(1, clngKey1 + 1) Then
　　　　　　'「個数」「金額」を集計
　　　　　　vntSum(1, 5) = vntSum(1, 5) + vntData(1, 5)
　　　　　　vntSum(1, 6) = vntSum(1, 6) + vntData(1, 6)
　　　　Else
　　　　　　'合計を集計
　　　　　　vntTotal(5) = vntTotal(5) + vntSum(1, 5)
　　　　　　vntTotal(6) = vntTotal(6) + vntSum(1, 6)
　　　　　　'データを出力
　　　　　　lngWrite = lngWrite + 1
　　　　　　rngResult.Offset(lngWrite).Resize(, clngColumns).Value = vntSum
　　　　　　'読み込んだデータを集計用変数に代入
　　　　　　vntSum = vntData
　　　　End If
　　Next i
　　
　　'合計を出力
　　lngWrite = lngWrite + 1
　　rngResult.Offset(lngWrite).Resize(, clngColumns).Value = vntTotal
　　
　　strProm = "処理が完了しました"
　　　
Wayout:

　　'画面更新を再開
　　Application.ScreenUpdating = True
　　
　　Set rngList = Nothing
　　Set rngResult = Nothing
　　　
　　MsgBox strProm, vbInformation
　　　　　
End Sub

2 hits

▼

【71348】ソート→集計をマクロで ゆうか 12/2/24(金) 13:35