Sub Syukei()
'このマクロは、任意のレコード(行)数で、ランダムな商品名が存在するデータ表の集計をします。丁度、毎日の売上伝票の蓄積されたデータを集計するイメージで作成しました。
'変数の宣言
Dim i As Integer '繰り返し変数
Dim Gyou_Owari As Integer '最終行
Dim Gyou2_Owari As Integer '最終行(集計列)
Dim Retu_Owari As Integer '最終列
Dim Gokei_Suu(9) As Integer '合計数量
Dim Gokei_kingaku(9) As Single '合計金額
Dim SyohinKazu As Integer '商品の数
Dim TukiHi As String
'-----データの最終行-----------
'Excelのワークシートは、65,536行、256列で構成されている。
'従って、セル"A65536"から上に移動(xlUp：組み込み定数)して、領域の終端セル位置を見つけ(Endプロパティ)、その行番号を返す(Rowプロパティ)と最終行番号が取得できる。("A65536"セルにカーソルを置いて〔Ctrl〕＋↑キーを押した操作と同じ)
Gyou_Owari = [A65536].End(xlUp).Row
'-----データの最終列-----------
'セル"A13"から右に移動(xlToRight)して、領域の終端セルを見つけて(Endプロパティ)、その列番号を返す(Columnプロパティ)と最終列番号が取得できる。("A13"セルにカーソルを置いて〔Ctrl〕＋→キーを押した操作と同じ)
Retu_Owari = [A13].End(xlToRight).Column
MsgBox ("最終行＝" & Gyou_Owari & "，最終列＝" & Retu_Owari)
'------商品名の取得---------
'データ内にある商品コードと商品名を取得して、集計表を作成する。
'検索条件
'商品名が空以外、全ての商品を検索条件とする。
With ActiveSheet
.Cells(10, 1).Value = "商品名"
.Cells(11, 1).Value = "<>"""""
End With
'セルに名前を付ける
'検索条件の範囲に名前を付けます。
'RefersToR1C1 名前を付けるセル範囲をR1C1形式で指定します。(例："R10C1"は、"R"は行位置で10行目、"C"は列位置で左から1番目でA列を表しています。)
ActiveWorkbook.Names.Add Name:="検索データ", _
RefersToR1C1:="=集計マクロ!R10C1:R11C1"
'商品名を取得
'｢フィルタオプションの設定」と同じです。検索範囲は、「商品コード」と「商品名」です。ただ、"Unique:=True"により「重複するレコードは無視する」にチェックが入った状態になり、商品名の一覧表が出来上がります。
Range(Cells(13, 2), Cells(Gyou_Owari, 3)).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Application.Worksheets("集計マクロ").Range("検索データ"), _
CopyToRange:=Application.Worksheets("集計マクロ").Range("H2"), _
Unique:=True
'集計した商品を昇順にソート
'かっこよく商品名を昇順にソートします。
Gyou2_Owari = [H65536].End(xlUp).Row '集計列の最終行
SyohinKazu = Gyou2_Owari
'ソート
Range(Cells(2, 8), Cells(SyohinKazu, 9)).Select
Selection.Sort Key1:=Range("H3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
'-----商品別集計--------------
'商品毎に集計計算します。
'繰り返し変数の決め方
'集計した商品を昇順にソートする時に集計列の最終行を取得しているので、商品の始まり行は固定(3行目)なので"SyohinKazu
- 2"
For i = 1 To SyohinKazu - 2 '商品名の数だけ繰り返し
With ActiveSheet
.Cells(11, 1).Value = .Cells(i + 2, 9) '検索データに商品名を代入
End With
'商品名を検索
Range(Cells(13, 1), Cells(Gyou_Owari, Retu_Owari)).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Application.Worksheets("集計マクロ").Range("検索データ"),
_
CopyToRange:=Application.Worksheets("集計マクロ").Range("O1")
Gyou2_Owari = [O65536].End(xlUp).Row '検索結果の最終行
Select Case Gyou2_Owari
Case 2
'1行だけではSUM関数は使えない(必要ない)のでそのままデータを代入。
Gokei_Suu(i) = ActiveSheet.Cells(Gyou2_Owari, 15 + 5)
Gokei_kingaku(i) = ActiveSheet.Cells(Gyou2_Owari, 15 + 6)
Case Is > 2
'｢売上数｣、｢売上金額」の最終行＋１にSUM関数を相対参照で挿入して、その値を一次配列変数に代入します。R1C1形式の相対参照はExcelVBAのHelpを参照して下さい。
ActiveSheet.Cells(Gyou2_Owari + 1, 15 + 5).Formula = _
"=SUM(R2C20:R[-1]C)" '数量
ActiveSheet.Cells(Gyou2_Owari + 1, 15 + 6).Formula = _
"=SUM(R2C21:R[-1]C)" '金額
Gokei_Suu(i) = ActiveSheet.Cells(Gyou2_Owari + 1, 15 + 5)
Gokei_kingaku(i) = ActiveSheet.Cells(Gyou2_Owari + 1, 15 + 6)
End Select
'検索抽出範囲のクリア
Range(Cells(1, 15), Cells(Gyou2_Owari + 1 + 1, 15 + 6)).Select
Selection.ClearContents
Next i
'-----集計列の代入----------
'上記で取得した値を各々のセルに代入します。
For i = 1 To SyohinKazu - 2
'列は固定なので、行だけ繰り返し回数分順次繰り下げて値を代入してやる。
With ActiveSheet
.Cells(i + 2, 10).Value = Gokei_Suu(i)
.Cells(i + 2, 11).Value = Gokei_kingaku(i)
End With
Next i
'集計計算
'全ての値が代入できたら、SUM関数を集計表の最後に挿入してやる
With ActiveSheet
.Cells(SyohinKazu + 1, 11).Formula = "=SUM(R2C11:R[-1]C)"
.Cells(SyohinKazu + 1, 10).Value = "合計"
End With
'-----集計表の形成と修飾---------
'省略・・・
Range("A1").Select
MsgBox "集計計算が終わりました。"
End
End Sub
お土産 Macro1.zip（１．と同じファイルです）