[[20120515160013]]　『複数項目での集計』（クロノ）　ページの最後に飛ぶ

『複数項目での集計』（クロノ）

お世話様です。

他掲示板でも質問させていただいているのですが
マルチポストがOKということなのでこちらでも
質問させていただきます。

ご不快に思われた方、すみません。

お知恵をお貸しください。

ちょっと仕事で行き詰ってしまいました。

SHEET1の
A列に商品名
G列に在庫の有無（数字の1と2で表しています）
H列に販売先が入っています（これも１～8数字で表されています）

AAA 1 5
BBB 2 7
CCC 1 4
AAA 2 6
BBB 1 7
CCC 2 2

SHEET2に
商品名別にG列内の１と２それぞれのデータ個数と販売先のデータ個数を出したいです。

商品　1(有)　　2(無) 1(販売先) 2 3 4 5 6 7 8
AAA 　 1 1 1 1
BBB 1 2
CCC 2 1 1

分かりにくくてすみません。
ご理解いただけたでしょうか？
現在は手作業でちまちま集計をしているので
なんとかマクロで出来るようになりたいです。

よろしくお願いします。

因みにエクセルは2003でOS は　WINDOWS XPです

 他掲示板でもマルチポストはOKなの？

 ・・・まぁ一応。関数だけど

 Sheet2

 B2 =SUMPRODUCT((Sheet1!$A$1:$A$100=$A2)*(Sheet1!$G$1:$G$100=B$1))
 C2にコピー。

 D2 =SUMPRODUCT((Sheet1!$A$1:$A$100=$A2)*(Sheet1!$H$1:$H$100=D$1))
 K2までコピー

 C2:K2 下へコピー。

 (GobGob)

 マルチポスト先は下記のOffice TANAKAさんなんでマルチポストはOKですね。

http://officetanaka.com/patio/patio.cgi?mode=view&no=3280

 (マルチーズ)

 もともとの質問はマルチポスト先で解決済み。
 現在は追加質問を行っている模様。

 結局こちらの回答は放りぱなしで典型的(悪い意味で)なマルチポストだったな。
 (マルチーズ)

GobGob様

御礼遅れまして申し訳ございません。
ありがとうございます。

関数だとこうなるのですね！勉強になります。

マルチーズ様

アドレス表記、ありがとうございます。

僕のほうで対応が遅れたため、ご不快にさせてしまい申し訳ございません。

上記にて既にマルチポスト先をご案内いただいておりますが、ご本人様の了解をいただきましたので
こちらにも念のため教えていただいたコードを記載しておきたいと思います。

お名前記載については確認を取っていなかったので（汗）
ご興味のある方はマルチーズ様の記載リンクよりご確認ください。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

こんにちは～

[Sheet1]

 A         G       H
商品名  在庫有無 販売先
AAA        1       5
BBB        2       7
CCC        1       4
AAA        2       6
BBB        1       7
CCC        2       2
のように、
1行目は列見出しだと仮定して、処理手順としては
(1) Sheet2 のA列に Sheet1 A列の商品名のユニークなリストを書き出す.
(2) Sheet2 A列のソート
(3) Sheet2 A列の商品名順に Sheet1のA列から一致する商品名の行をみつけ、
　　G列が1なら Sheet2 の第2列の集計、2 なら Sheet2 の第３列の集計
      H列の値が 1～8 であれば その値に +3した列の値を +1 する.
と、こんなことをしていけばいいと思いますが、
(1)の処理は 一般機能のフィルタオプションで 重複データのカットをして抽出すれば
　　できます。
(3)の処理は セル上でちまちまやると画面がチラつくので、商品数×10列 の集計用
　　配列をメモリ内に用意して、そこで集計します。（集計した最後に、シートに
　　戻します）
     「ある商品が出力用配列の何行目のデータか」は dictionaryオブジェクトを使って
      商品名と出力行番号の対応表を作っておけば、検索は各商品について一回で済みます。

★ 事前に Microsoft Scripting Runtime への参照設定が必要です。

Sub Try1()

    Dim r1 As Range
    Dim r2 As Range

    Set r1 = Worksheets("Sheet1").Range("A1").CurrentRegion.Columns(1)
    Set r2 = Worksheets("Sheet2").Range("A1")
    r2.Worksheet.UsedRange.ClearContents

    'Sheet1のA列のユニークな商品名を Sheet2 A列にリストする
    r1.AdvancedFilter xlFilterCopy, CopyToRange:=r2, Unique:=True
    Set r2 = r2.CurrentRegion
    r2.Sort Key1:=r2, Header:=xlYes  '商品名でソート

    Dim i As Long
    Dim c As Range
    Dim dic As Dictionary
    Set dic = New Dictionary
    'ユニークな商品名をdicのキーに登録(Headerを除く)
    For Each c In Intersect(r2, r2.Offset(1))
        i = i + 1
        dic.Add c.Value, i  'dicのアイテムに出力行番号をおぼえておく
    Next

    ReDim a(1 To dic.Count, 1 To 10) '出力用配列を用意
    Dim j As Long
    For Each c In Intersect(r1, r1.Offset(1))
        i = dic(c.Value)             'dictionaryに覚えてある その商品名の行番号
        Select Case c(1, 7).Value 'G列データ処理
            Case 1: a(i, 1) = a(i, 1) + 1
            Case 2: a(i, 2) = a(i, 2) + 1
        End Select
        j = c(1, 8).Value     'H列データ処理
        Select Case j
            Case 1 To 8
                j = j + 2
                a(i, j) = a(i, j) + 1 'H列データは配列a のj+2列でカウント
        End Select
    Next
    r2.Item(2, 2).Resize(dic.Count, 10).Value = a  'Sheet2[B2]セル以降に 配列内容を貼り付けます
    r2.Item(1, 2).Resize(, 10).Value = Array("在庫あり", "在庫なし", 1, 2, 3, 4, 5, 6, 7, 8) '見出しを書き込みます

    Set dic = Nothing
End Sub

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

（クロノ）

コメント返信：

[ 一覧(最新更新順) ]

[[20120515160013]] 『複数項目での集計』（クロノ） ページの最後に飛ぶ

[[20120515160013]]　『複数項目での集計』（クロノ）　ページの最後に飛ぶ