[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『DBの集計のオート化』（信州） Windows2000、Excel2000
久し振りの投稿です。 下記のDBは売上日順に入力したものです。これを ①商品分類順に並べ替える ②商品分類毎に平均値、最高値、最低値を求め、それぞれの値を各商品分類行の最後行の次行に 入れる作業を手作業で行っていますが、それをVBA化出来ないか、試行錯誤中です。どなたか知恵を貸して下さいませんか？
Ａ：最初のＤＢ
売上日 店コード 商品分類 売上金額 12/14/05 A店 食品１ 19550 12/14/05 B店 飲料２ 15000 12/13/05 A店 電化製品１ 360000 12/13/05 C店 食品１ 5100 12/13/05 B店 飲料３ 2700 12/13/05 Ｅ店 飲料２ 6000 12/12/05 Ｇ店 食品１ 25500 12/12/05 A店 電化製品１ 120000 12/12/05 Ｅ店 食品３ 240000 12/11/05 A店 飲料３ 9600 12/11/05 Ｈ店 食品１ 30600 12/11/05 B店 電化製品１ 3000000 12/11/05 B店 飲料２ 45000 12/11/05 Ｇ店 食品３ 171000 12/11/05 A店 電化製品２ 7200000 12/11/05 Ｅ店 食品２ 79500 12/10/05 Ｉ店 飲料２ 90000 12/10/05 A店 食品３ 270000 12/10/05 Ｇ店 電化製品２ 3600000 12/10/05 Ｊ店 飲料３ 31200 12/10/05 Ｈ店 電化製品２ 4320000 12/10/05 Ｈ店 食品３ 240000 12/10/05 Ｉ店 飲料３ 9600 12/10/05 Ｊ店 飲料２ 12000 12/10/05 Ｄ店 電化製品３ 360000
Ｂ：商品分類の昇順に並べ替え
Sub 商品分類別並べ替え()
Range("C2").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
End Sub
を実行して
売上日 店コード 商品分類 売上金額 12/14/05 B店 飲料２ 15000 12/13/05 Ｅ店 飲料２ 6000 12/11/05 B店 飲料２ 45000 12/10/05 Ｉ店 飲料２ 90000 12/10/05 Ｊ店 飲料２ 12000 12/13/05 B店 飲料３ 2700 12/11/05 A店 飲料３ 9600 12/10/05 Ｊ店 飲料３ 31200 12/10/05 Ｉ店 飲料３ 9600 12/14/05 A店 食品１ 19550 12/13/05 C店 食品１ 5100 12/12/05 Ｇ店 食品１ 25500 12/11/05 Ｈ店 食品１ 30600 12/11/05 Ｅ店 食品２ 79500 12/12/05 Ｅ店 食品３ 240000 12/11/05 Ｇ店 食品３ 171000 12/10/05 A店 食品３ 270000 12/10/05 Ｈ店 食品３ 240000 12/13/05 A店 電化製品１ 360000 12/12/05 A店 電化製品１ 120000 12/11/05 B店 電化製品１ 3000000 12/11/05 A店 電化製品２ 7200000 12/10/05 Ｇ店 電化製品２ 3600000 12/10/05 Ｈ店 電化製品２ 4320000 12/10/05 Ｄ店 電化製品３ 360000
Ｃ：Ｂを商品分類毎にAVG,MAX,MINを求め、それぞれの値を各商品分類行の最後行の次行に 入れる作業を手作業で行った後
売上日 店コード 商品分類 売上金額 12/14/05 B店 飲料２ 15000 12/13/05 Ｅ店 飲料２ 6000 12/11/05 B店 飲料２ 45000 12/10/05 Ｉ店 飲料２ 90000 12/10/05 Ｊ店 飲料２ 12000 AVG 33600 MAX 90000 MIN 6000 12/13/05 B店 飲料３ 2700 12/11/05 A店 飲料３ 9600 12/10/05 Ｊ店 飲料３ 31200 12/10/05 Ｉ店 飲料３ 9600 AVG 13275 MAX 31200 MIN 2700 12/14/05 A店 食品１ 19550 12/13/05 C店 食品１ 5100 12/12/05 Ｇ店 食品１ 25500 12/11/05 Ｈ店 食品１ 30600 AVG 20187.5 MAX 30600 MIN 5100 12/11/05 Ｅ店 食品２ 79500 AVG 79500 MAX 79500 MIN 79500 12/12/05 Ｅ店 食品３ 240000 12/11/05 Ｇ店 食品３ 171000 12/10/05 A店 食品３ 270000 12/10/05 Ｈ店 食品３ 240000 AVG 230250 MAX 270000 MIN 171000 12/13/05 A店 電化製品１ 360000 12/12/05 A店 電化製品１ 120000 12/11/05 B店 電化製品１ 3000000 AVG 912750 MAX 3000000 MIN 120000 12/11/05 A店 電化製品２ 7200000 12/10/05 Ｇ店 電化製品２ 3600000 12/10/05 Ｈ店 電化製品２ 4320000 AVG 3810000 MAX 7200000 MIN 120000 12/10/05 Ｄ店 電化製品３ 360000 AVG 360000 MAX 360000 MIN 360000
Ｃの作業がしんどいのでVBA化出来ないかな～と考えているのですが・・・(信州）
分類ごとに並べ替える。 次は、データ→集計で 最小値の集計：集計のダイアログで「現在の集計表と入れ替える」のチェックを入れる。 最大値の集計：集計のダイアログで「現在の集計表と入れ替える」のチェックを外す。 平均の集計：集計のダイアログで「現在の集計表と入れ替える」のチェックを外す。 を、自動記録したらどうでしょう。 （Hatch)
こんな感じで...
Sub test()
Dim i As Long, ii As Long, x As Long
Application.ScreenUpdating = False
With ActiveSheet
With .Range("a1").CurrentRegion
On Error Resume Next
With .Columns(1)
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Err.Clear
.Sort key1:=.Cells(2, 3), order1:=xlAscending, _
key2:=.Cells(2, 1), order2:=xlAscending, header:=xlYes
End With
i = 2: x = i
Do
If .Cells(i + 1, "c") <> .Cells(i, "c") Then
.Rows(i + 1 & ":" & i + 3).Insert
With .Cells(i + 1, "c")
.FormulaR1C1 = "=average(r" & x & "c4:r[-1]c4)"
.Offset(1).FormulaR1C1 = _
"=max(r" & x & "c4:r[-2]c4)"
.Offset(2).FormulaR1C1 = _
"=min(r" & x & "c4:r[-3]c4)"
End With
i = i + 3: x = i + 1
End If
i = i + 1
Loop Until .Cells(i, "c") = ""
End With
Application.ScreenUpdating = True
End Sub
(seiya)
オー、すごーい！seiya様 一発でうまくいきました。大感激です！これから上記のVBAを分析してみますが、 AVG,MAX,MINを入れる事は出来ないでしょうか？ (信州）
With .Cells(i + 1, "c")
.FormulaR1C1 = "=average(r" & x & "c4:r[-1]c4)"
.Offset(1).FormulaR1C1 = _
"=max(r" & x & "c4:r[-2]c4)"
.Offset(2).FormulaR1C1 = _
"=min(r" & x & "c4:r[-3]c4)"
End With
を、下記に変更してみてください？
With .Cells(i + 1, "c")
.offset(,-1).resize(3)=application.transpose(array("Avr","Max","Min"))
.FormulaR1C1 = "=average(r" & x & "c4:r[-1]c4)"
.Offset(1).FormulaR1C1 = _
"=max(r" & x & "c4:r[-2]c4)"
.Offset(2).FormulaR1C1 = _
"=min(r" & x & "c4:r[-3]c4)"
End With
(seiya)
有難うございます。これで、毎週悩まされていた集計作業から解放されそうです。（信州）
野暮な質問ですが、
With .Range("a1").CurrentRegion
On Error Resume Next
With .Columns(1) -->①
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete -->②
End With
Err.Clear
.Sort key1:=.Cells(2, 3), order1:=xlAscending, _
key2:=.Cells(2, 1), order2:=xlAscending, header:=xlYes -->③
End With
①,②,③の意味は何でしょうか？
With .Range("a1").CurrentRegion
On Error Resume Next
With .Columns(1) -->①
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete -->②
End With
Err.Clear
.Sort key1:=.Cells(2, 3), order1:=xlAscending, _
key2:=.Cells(2, 1), order2:=xlAscending, header:=xlYes -->③
End With
上記は、Avr, Max, Minが挿入される前の状態に戻す作業です。
① Range("a1").currentregion の columns(1) ということはA列でcurrentregionの最下行までを指定
② Avr, Max, Minが挿入されている状態では、その同行は常に空白になるので、これを目安に行削除。
③ C列、A列の優先順位で並び替え。
(seiya)
有難うございます。（信州）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.