[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『実績がないときは0といれて集計したい』（QP）
みなさま よろしくお願いいたします。
グループ 担当者 商品 売上 グループ１ 梅 A 1000 グループ１ 梅 B 200 グループ１ 梅 C 5000 グループ１ 梅 D 300 グループ１ 梅 E 200 グループ１ 桃 A 500 グループ１ 桃 B 500 グループ１ 桃 D 7000 グループ2 柿 C 1000 グループ2 柿 D 3000 グループ2 柿 E 5000 グループ3 松 A 100 グループ3 松 B 200
この表を下記のように集計したく思っています。 商品は5種類ですが担当者の実績がないところは0円といれて 集計したいのです。 グループには複数の担当者がいるところといないところがあります。
グループ 担当者 商品 売上 グループ１ 梅 A 1000 グループ１ 梅 B 200 グループ１ 梅 C 5000 グループ１ 梅 D 300 グループ１ 梅 E 200 合計 6700 グループ１ 桃 A 500 グループ１ 桃 B 500 グループ１ 桃 C 0 グループ１ 桃 D 7000 グループ１ 桃 E 0 合計 8000 合計 14700 グループ2 柿 A 0 グループ2 柿 B 0 グループ2 柿 C 1000 グループ2 柿 D 3000 グループ2 柿 E 5000 合計 9000 合計 9000 グループ3 松 A 100 グループ3 松 B 200 グループ3 松 C 0 グループ3 松 D 0 グループ3 松 E 0 合計 300 合計 300
グループ、担当者、商品の欄を作って金額を入れるように式を作ってみたのですが 担当者が増えたり減ったりが激しく、枠をつくるだけで 大変な時間がかってしまいます。マクロしかないのでしょうか？ どうぞ助言お願いいたします。
ピボットテーブルではどうでしょうか。
（川野鮎太郎）
川野様
お返事ありがとうございます。最初ピボットテーブルでしようと試みたのですが その月売上が無かった商品の欄を0円とすることができないのです。 ピボットでも実績がない商品の欄が0円と表示できればそれでよいのですが 過去ログをみたところできないようです。 よろしくお願いいたします。
元々、商品が5種類って決まっているのでしょうか。 元のデータに0円のデータを書き込んでおけば良いのでは。
（川野鮎太郎）
川野様
ありがとうございます。元々の商品の種類は決まっています。 このデータは会社のシステムからエクセルに抽出しているのです。 担当者の実績のないデータを探して0円を書き込むことは大変なのです。 なぜなら担当が100人近くいるからです。 よろしくお願いいたします。
グループ名と、担当者名は相対関係がありますか。 また商品名があらかじめ決まっているなら、商品の種類は何種類でしょうか。 それから、元のデータが入っているシート名、セル番地を具体的に教えてください。
（川野鮎太郎）
川野様
何度もありがとうございます。
A B C D 1 グループ 担当者 商品 売上 2 グループ１ 梅 A 1000 3 グループ１ 梅 B 200 4 グループ１ 梅 C 5000 5 グループ１ 梅 D 300 6 グループ１ 梅 E 200 7 グループ１ 桃 A 500 8 グループ１ 桃 B 500 9 グループ１ 桃 D 7000 10 グループ２ 柿 C 1000 11 グループ２ 柿 D 3000 12 グループ２ 柿 E 5000 13 グループ３ 松 A 100 14 グループ３ 松 B 200
商品の数はA〜Eの5種類、担当者はそれぞれの1つのグループに属しています。 担当者が大勢いるところと一人しかいないところもあります。 よろしくお願いいたします。
マクロでやってみました。
元のデータのシート名を Sheet1
書き出し先のシート名を Sheet3に設定しています。
※Sheet3は前もって空白のシートを用意しておいてください。
商品名も具体的に不明なため、商品A 商品B ・・・ としています。
Option Explicit
Sub Test()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim LastR As Long, i As Long, Rows_Count As Long
Dim n As Long, x As Long
Dim MyGoods_Name As Variant, MyGoods As Variant
Dim MyA() As Variant
Const MyCol As String = "H" '作業列をH列に作成
Const Goods_Name_Count As Long = 5 '商品の種類
Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet3")
With Sh1
Range(.Range("A1"), .Range("A65536").End(xlUp)).Resize(, 2).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Sh2.Range(MyCol & "1"), Unique:=True
Rows_Count = Range(Sh2.Range(MyCol & "1"), Sh2.Range(MyCol & "65536").End(xlUp)).Rows.Count
MyGoods = Array("グループ名", "担当名", "商品", "売上")
MyGoods_Name = Array("商品A", "商品B", "商品C", "商品D", "商品E")
ReDim MyA(0 To (Rows_Count - 1) * Goods_Name_Count, 1 To 4)
For n = 0 To UBound(MyGoods)
MyA(0, n + 1) = MyGoods(n)
Next n
End With
With Sh2
For i = 1 To UBound(MyA())
For x = 1 To 2
MyA(i, x) = .Range(MyCol & "1").Offset(Int((i - 1) / 5) + 1, x - 1)
Next x
MyA(i, 3) = MyGoods_Name((i - 1) Mod 5)
MyA(i, 4) = ""
Next i
.Range("A1").Resize(UBound(MyA()) + 1, UBound(MyGoods) + 1).Value = MyA()
.Columns(MyCol).Resize(, 2).ClearContents
.Range("D2:D" & UBound(MyA()) + 1).Formula = _
"=SUMPRODUCT((Sheet1!B$2:B$14=B2)*(Sheet1!C$2:C$14=C2),Sheet1!D$2:D$14)"
.Range("D2:D" & UBound(MyA()) + 1).Copy
.Range("D2:D" & UBound(MyA()) + 1).PasteSpecial Paste:=xlPasteValues
End With
Erase MyGoods
Erase MyGoods_Name
Erase MyA
Set Sh1 = Nothing
Set Sh2 = Nothing
End Sub
あとはピボットテーブルで出来ると思います。
（川野鮎太郎）
河野様
ありがとうございました！できました。 すばらしいです！
そして申し訳ないのですがもう１点教えていただいてもよろしいでしょうか？ 現在は商品は５種類ですが、この種類が増えた場合
商品の数を１０個にし Const Goods_Name_Count As Long = 10 '商品の種類
ここで商品の名前を増やし
MyGoods_Name = Array("商品A", "商品B", "商品C", "商品D", "商品E","商品F","商品G","商品H","商品I","商品J")
1から10まで数える ReDim MyA(0 To (Rows_Count - 1) * Goods_Name_Count, 1 To 10)
そのあとここの部分の直し方がわからないのですが
For i = 1 To UBound(MyA())
For x = 1 To 2
MyA(i, x) = .Range(MyCol & "1").Offset(Int((i - 1) / 5) + 1, x - 1)
Next x
MyA(i, 3) = MyGoods_Name((i - 1) Mod 5)
MyA(i, 4) = ""
Next i
何度も申し訳ないのですがよろしくお願いいたします。
簡単に修正できるようにしていたつもりですが、いくつか対応不足でしたね(^_^A;
以下のコードに変えてみてください。
Option Explicit
Sub Test()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim LastR As Long, i As Long, Rows_Count As Long
Dim Sh1_Rows_Count As Long
Dim n As Long, x As Long
Dim MyGoods_Name As Variant, MyGoods As Variant
Dim MyA() As Variant
Dim Goods_Name_Count As Long
Const MyCol As String = "H" '作業列をH列に作成
Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet3")
With Sh1
Sh1_Rows_Count = Range(.Range("A1"), .Range("A65536").End(xlUp)).Rows.Count
Range(.Range("A1"), .Range("A65536").End(xlUp)).Resize(, 2).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Sh2.Range(MyCol & "1"), Unique:=True
Rows_Count = Range(Sh2.Range(MyCol & "1"), Sh2.Range(MyCol & "65536").End(xlUp)).Rows.Count
MyGoods = Array("グループ名", "担当名", "商品", "売上")
MyGoods_Name = Array("商品A", "商品B", "商品C", "商品D", "商品E")
Goods_Name_Count = UBound(MyGoods_Name) + 1
ReDim MyA(0 To (Rows_Count - 1) * Goods_Name_Count, 1 To 4)
For n = 0 To UBound(MyGoods)
MyA(0, n + 1) = MyGoods(n)
Next n
End With
With Sh2
For i = 1 To UBound(MyA())
For x = 1 To 2
MyA(i, x) = .Range(MyCol & "1").Offset(Int((i - 1) / Goods_Name_Count) + 1, x - 1)
Next x
MyA(i, 3) = MyGoods_Name((i - 1) Mod Goods_Name_Count)
MyA(i, 4) = ""
Next i
.Cells.ClearContents
.Range("A1").Resize(UBound(MyA()) + 1, UBound(MyGoods) + 1).Value = MyA()
.Range("D2:D" & UBound(MyA()) + 1).Formula = _
"=SUMPRODUCT((Sheet1!B$2:B$" & Sh1_Rows_Count & "=B2)*(Sheet1!C$2:C$" & _
Sh1_Rows_Count & "=C2),Sheet1!D$2:D$" & Sh1_Rows_Count & ")"
.Range("D2:D" & UBound(MyA()) + 1).Copy
.Range("D2:D" & UBound(MyA()) + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.Goto .Range("A1")
End With
Erase MyGoods
Erase MyGoods_Name
Erase MyA
Set Sh1 = Nothing
Set Sh2 = Nothing
End Sub
これだと、MyGoods_Name = Array("商品A", "商品B", "商品C", "商品D", "商品E") だけを
追加または削除していけば対応可能になると思います。
（川野鮎太郎）
川野 様 できました！本当にありがとうございます。
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.