[[20180914131539]]　『表を細かく分類抽出していくつもの表を作成』（たま）　ページの最後に飛ぶ

『表を細かく分類抽出していくつもの表を作成』（たま）

いつもエクセルの学校と皆様の書き込みで勉強させていただいています

大がかりな内容になってしまいますが、以下のようなVBAコードは作成できるのでしょうか？

内容
表を細かく分類抽出していくつもの表を作成しています
列項目は以下の通り
Ａ列　Ｂ列　Ｃ列　Ｄ列
コード　部所名　売上項目　金額
抽出に関係ない列は10列以上ありますが割愛）

コードは本来36コードありますがとりあえず100、110、H01の三つとし
部所名も50項目ほどありますがとりあえず営業所、A工場、B工場、製造部の4つとします
売上項目は、売価、原価　2項目です
コードと部署名には組み合わせがあり
営業所　100、110、H01
A工場　100、H01
B工場　110、H01
製造部　100、110、H01
となります
各コードには売上項目に　売価、原価　がそれぞれあります
上記を踏まえ以下の表があります

A列　B列　C列　D列
コード　部所名　売上項目　金額
100　A工場　原価　500
H01　A工場　原価　500
110　B工場　原価　750
H01　製造部　原価　900
100　営業所　売価　5000
110　製造部　原価　5050
110　営業所　売価　5060
100　営業所　原価　7000
100　B工場　売価　8060
H01　B工場　売価　8060
100　A工場　売価　15000
H01　営業所　売価　15800
110　営業所　売価　25000
110　製造部　売価　35600
100　営業所　売価　80000
100　製造部　売価　150000

これを以下の様に集計します

コード　部所名　売上項目　金額
100　営業所　売価　5000
100　営業所　売価　80000
　　　　100売価計　85000
100　営業所　原価　7000
　　　　100原価計　7000
110　営業所　売価　5060
110　営業所　売価　25000
　　　　110売価計　30060
H01　営業所　売価　15800
　　　　H01売価計　15800
　　　　　売上高　130860
　　　　売上原価　7000
　　　　　　粗利　123860

コード部所名売上項目金額
100　A工場　売価　15000
100　B工場　売価　8060
　　　　100売価計　23060
100　A工場　原価　500
　　　　100原価計　500
110　B工場　原価　750
　　　　110原価計　750
H01　B工場　売価　8060
　　　　H01売価計　8060
H01　A工場　原価　500
　　　　H01原価計　500
　　　　売上高　31120
　　　　売上原価　1750
　　　　粗利　29370

コード　部所名　売上項目　金額
100　製造部　売価　150000
　　　　100売価計　150000
　　　　売上高　150000
　　　　売上原価　0
　　　　粗利　150000

コード　部所名　売上項目　金額
110　製造部　売価　35600
　　　　110売価計　35600
110　製造部　原価　5050
　　　　110原価計　5050
H01　製造部　原価　900
　　　　H01原価計　900
　　　　売上高　35600
　　　　売上原価　5950
　　　　粗利　29650

　　　　総売上高　347580
　　　　総売上原価　14700
　　　　総粗利　332880

小計、合計値は関数で表示されています
粗利は売上高-売上原価で表示させます

集計表を見てお分かりの通り、営業所、A工場とB工場、製造部でコードが100のもの、製造部でコードが110とH01のもの
で、コード単位でかつ売上項目単位で集計し、小計が入っています
また、集計表下部に売上高、売上原価をそれそれの小計を足して算出し、粗利は売上高－原価で算出しています
各コードごとに売価、原価があると書きましたが中にはないときもあり、コードそのものもない場合がありますが
その場合は集計小計を都度スキップします
長くなりましたがこんな集計をVBAで作成できるのでしょうか？
せめて集計が一つの表か、小計がなければいいのですが部署単位で表を作成し一つのシート内に作成
（縦に並べ、表と表の間を2行あけて作成します）しなければならないため困っています
現在は手作業で行うため工数がばかになりません
今回はデータを端折って書いていますが先にも述べた通り参照コードも部署も山ほどあり、件数も5千件を超えています

宜しくお願いいたします

＜使用 Excel：Excel2016、使用 OS：Windows7 ＞

ざ～っとしか読んでないので外してるかもしれないですけど

＞VBAで作成できるのでしょうか？
できるできないで言えばできるんじゃなないでしょうか。

ただ、マクロを作る作業の手間と手作業の手間を考えて釣り合うかは不明です。
ピポットテーブルの結果をコピーしてちょっと加工するくらいで、それほど手間とも思えないのですが
作業で行うため工数というか、一連の作業時間どのくらいかかってるんですか？
（もこな２） 2018/09/14(金) 15:28

 ※回答ではありませんすみません

 >コードと部署名には組み合わせがあり
 >営業所　100、110、H01
 >A工場　100、H01
 >B工場　110、H01
 >製造部　100、110、H01
 >となります

 ご提示のサンプルには「B工場」でコードが「100」のパターンが含まれてますね。
 一応、サンプル上だけの誤りと解釈して進めます。

 例えばなんですけど

 __|	___A____	___B____	___C____	___D____	___E____	____F_____	____G____	___H____	___I____
  1|	コード  	部所名  	売上項目	金額    	Sort集計	Sortコード	Sort売/原	Sort部所	小計区分
  2|	100     	A工場   	原価    	     500	       2	         1	        2	       1	212原価 
  3|	H01     	A工場   	原価    	     500	       2	         3	        2	       1	232原価 
  4|	110     	B工場   	原価    	     750	       2	         2	        2	       2	222原価 
  5|	H01     	製造部  	原価    	     900	       4	         3	        2	       4	432原価 
  6|	100     	営業所  	売価    	   5,000	       1	         1	        1	       3	111売価 
  7|	110     	製造部  	原価    	   5,050	       4	         2	        2	       4	422原価 
  8|	110     	営業所  	売価    	   5,060	       1	         2	        1	       3	121売価 
  9|	100     	営業所  	原価    	   7,000	       1	         1	        2	       3	112原価 
 10|	100     	B工場   	売価    	   8,060	       2	         1	        1	       2	211売価 
 11|	H01     	B工場   	売価    	   8,060	       2	         3	        1	       2	231売価 
 12|	100     	A工場   	売価    	  15,000	       2	         1	        1	       1	211売価 
 13|	H01     	営業所  	売価    	  15,800	       1	         3	        1	       3	131売価 
 14|	110     	営業所  	売価    	  25,000	       1	         2	        1	       3	121売価 
 15|	110     	製造部  	売価    	  35,600	       4	         2	        1	       4	421売価 
 16|	100     	営業所  	売価    	  80,000	       1	         1	        1	       3	111売価 
 17|	100     	製造部  	売価    	 150,000	       3	         1	        1	       4	311売価

 [Sort集計] ----集計表単位に番号を付番
                「営業所」なら「1」
                「A工場、B工場」なら「2」
                「製造部でコードが100」なら「3」
                「製造部でコードが110とH01」なら「4」
 [Sortコード] --「コード」列の並び順を付番([コード]列そのまま使っても良いのかも。コードの内容によっては)
 [Sort売/原] ---「売上項目」列の並び順を付番(「売価」が「1」、「原価」が「2」)
 [Sort部所] ----「部所名」列の並び順を付番
                (集計表で「部所名」が整列してなくて良いのならこれは不要)

 [小計区分] ---- =[Sort集計]&[Sortコード]&[Sort売/原]&[売上項目]

 として、
 [Sort部所]を昇順並べ替えしてから
 [小計区分]を昇順並べ替え。その後、
 [小計]機能で[小計区分]をグループの基準にして[金額]を集計し、
 E列～H列を非表示にしたら下表の様な感じになります。

 __|	___A____	___B____	___C____	___D____	_____I______
  1|	コード  	部所名  	売上項目	金額    	小計区分    
  2|	100     	営業所  	売価    	   5,000	111売価     
  3|	100     	営業所  	売価    	  80,000	111売価     
  4|	        	        	        	  85,000	111売価 集計
  5|	100     	営業所  	原価    	   7,000	112原価     
  6|	        	        	        	   7,000	112原価 集計
  7|	110     	営業所  	売価    	   5,060	121売価     
  8|	110     	営業所  	売価    	  25,000	121売価     
  9|	        	        	        	  30,060	121売価 集計
 10|	H01     	営業所  	売価    	  15,800	131売価     
 11|	        	        	        	  15,800	131売価 集計

 12|	100     	A工場   	売価    	  15,000	211売価     
 13|	100     	B工場   	売価    	   8,060	211売価     
 14|	        	        	        	  23,060	211売価 集計
 15|	100     	A工場   	原価    	     500	212原価     
 16|	        	        	        	     500	212原価 集計
 17|	110     	B工場   	原価    	     750	222原価     
 18|	        	        	        	     750	222原価 集計
 19|	H01     	B工場   	売価    	   8,060	231売価     
 20|	        	        	        	   8,060	231売価 集計
 21|	H01     	A工場   	原価    	     500	232原価     
 22|	        	        	        	     500	232原価 集計

 23|	100     	製造部  	売価    	 150,000	311売価     
 24|	        	        	        	 150,000	311売価 集計

 25|	110     	製造部  	売価    	  35,600	421売価     
 26|	        	        	        	  35,600	421売価 集計
 27|	110     	製造部  	原価    	   5,050	422原価     
 28|	        	        	        	   5,050	422原価 集計
 29|	H01     	製造部  	原価    	     900	432原価     
 30|	        	        	        	     900	432原価 集計

 31|	        	        	        	 362,280	総計

 これだけでも(VBA使わなくとも)、
 完成イメージに近い所までは持って来れてるんじゃないのかな?
 と勝手に思ってるんですけど、
 もっとサクッと「ボタン一つで完成!」みたいなのをお望みなのでしょうかね?

 VBAでやるにしても
 上記例の様に「集計表」を区分けする為の項目は単独で持たせておいた方が
 組み立てが楽になるんじゃないかと思います。(結局言いたかったのはそれだけです^^;)

（白茶） 2018/09/15(土) 13:25

もこな２さん、白茶さん
お世話になっています

VBAにこだわる必要はないですが、
現在5時間ほどかけています
件数とコード数、部所が半端ないので
関数によるフラグ立てでもう少し効率よくできるかを
考えてみます

ありがとうございました
（たま） 2018/09/18(火) 16:37

Sub main()

    'アクティブシートが対象（バックアップを忘れずに）
    '1行目は見出し（Ａ１＝コード　～　Ｄ１＝金額）
    '2行目以下がデータ
    Dim c As Range, r As Range, dic1 As Object, dic2 As Object, k
    For Each c In Range("A:A").SpecialCells(2)
        If InStr(c.Offset(, 1).Value, "営業所") > 0 Then c.Offset(, 4).Value = 1000
        If InStr(c.Offset(, 1).Value, "工場") > 0 Then c.Offset(, 4).Value = 2000
        If InStr(c.Offset(, 1).Value, "製造部") > 0 Then
        c.Offset(, 4).Value = 3000
        If InStr(c.Value, "100") = 0 Then c.Offset(, 4).Value = 4000
        End If
        If InStr(c.Value, "110") > 0 Then c.Offset(, 4).Value = c.Offset(, 4).Value + 100
        If InStr(c.Value, "H01") > 0 Then c.Offset(, 4).Value = c.Offset(, 4).Value + 200
        If InStr(c.Offset(, 2).Value, "原価") > 0 Then c.Offset(, 4).Value = c.Offset(, 4).Value + 10
    Next c
    With ActiveSheet.Sort
        .SortFields.Add Key:=Range("B2:B" & Rows.Count)
        .SetRange Range("A1:E" & Rows.Count)
        .Header = xlYes
        .Apply
    End With
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    dic2(5000) = "総売上高"
    dic2(5001) = "総売上原価"
    dic2(5002) = "総粗利"
    For Each c In Range("A2:A" & Rows.Count).SpecialCells(2)
        dic1(Val(c.Offset(, 4)) + 1) = dic1(Val(c.Offset(, 4)) + 1) + c.Offset(, 3).Value
        dic2(Val(c.Offset(, 4)) + 1) = c.Value & c.Offset(, 2).Value & "計"
        dic2(Left(c.Offset(, 4), 1) * 1000 + 990) = "売上高"
        dic2(Left(c.Offset(, 4), 1) * 1000 + 991) = "売上原価"
            If c.Offset(, 2).Value = "売価" Then
                dic1(Left(c.Offset(, 4), 1) * 1000 + 990) = dic1(Left(c.Offset(, 4), 1) * 1000 + 990) + c.Offset(, 3).Value
                dic1(5000) = dic1(5000) + c.Offset(, 3).Value
            Else
            dic1(Left(c.Offset(, 4), 1) * 1000 + 991) = dic1(Left(c.Offset(, 4), 1) * 1000 + 991) + c.Offset(, 3).Value
                dic1(5001) = dic1(5001) + c.Offset(, 3).Value
            End If
        dic1(Left(c.Offset(, 4), 1) * 1000 + 992) = dic1(Left(c.Offset(, 4), 1) * 1000 + 990) - dic1(Left(c.Offset(, 4), 1) * 1000 + 991)
        dic2(Left(c.Offset(, 4), 1) * 1000 + 992) = "粗利"
        dic1(Left(c.Offset(, 4), 1) * 1000 + 998) = ""
        dic1(Left(c.Offset(, 4), 1) * 1000 + 999) = ""
    Next c
    dic1(5002) = dic1(5000) - dic1(5001)
    Set r = Range("A" & Rows.Count).End(xlUp).Offset(1)
    For Each k In dic1
        If InStr(k, "999") = 0 Then
            r.Resize(, 5).Value = Array("", "", dic2(k), IIf(InStr(k, "998") = 0, Val(dic1(k)), dic1(k)), k)
        ElseIf k <> 4999 Then
            r.Resize(, 5).Value = Array("コード", "部所名", "売上項目", "金額", k)
        Else
            r.Resize(, 5).Value = Array("", "", "", "", "")
        End If
        Set r = r.Offset(1)
    Next k
    With ActiveSheet.Sort
        .SortFields.Add Key:=Range("E2:E" & Rows.Count)
        .SetRange Range("A1:E" & Rows.Count)
        .Header = xlYes
        .Apply
    End With
    Columns(5).ClearContents
End Sub
（mm） 2018/09/19(水) 15:36

mmさん
すごいです！

一か所
最後のソート部分を以下の様に直しましたところ完璧にこちらの希望通りになりました

.SortFields.Add Key:=Range("E2")

本来36コード
部所名50項目

は個別にソースを追加していけばいいですね
ただ数が多すぎてコードが大変なことになりそうです

ありがとうございました
（たま） 2018/09/20(木) 11:51

コメント返信：

[ 一覧(最新更新順) ]

[[20180914131539]] 『表を細かく分類抽出していくつもの表を作成』（たま） ページの最後に飛ぶ

[[20180914131539]]　『表を細かく分類抽出していくつもの表を作成』（たま）　ページの最後に飛ぶ