[[20161022121804]] 『集計方法』(パシリ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『集計方法』(パシリ)

店番 顧客番号  保有商品
02 AA001  津軽リンゴ
02 AA001  青森リンゴ
03 AA003  津軽リンゴ
03 AA003  ジョナゴールド
03 AA003 津軽リンゴ
03 AA005  青森リンゴ

上記の表から、店番・顧客ごとに同じ商品は1つとして集計したいです。 
        店番02の顧客AA001が保有している商品は2つ
        店番03の顧客AA003が保有している商品は2つ
        店番03の顧客AA005が保有している商品は1つ
と集計できる簡単な方法を教えて下さい。集計する顧客数はその都度違います。初心者ですが、できればマクロを組みたいです。よろしくお願いします。

< 使用 Excel:Excel2013、使用 OS:unknown >


 ピボットが一番早いです。
 ちょこちょこ っと操作するだけで、

    |[A] |[B]     |[C]                    
 [1]|店番|顧客番号|データの個数 / 保有商品
 [2]|   2|AA001|                      2
 [3]|   3|AA003|                      3
 [4]|    |AA005|                      1

 こんな表が出来上がります。
 マクロでやりたいなら、

 1.これを手作業で作成する過程そのものをマクロ記録して使う。
 2.作成までは手作業で行い、このピボットを選択して、更新でデーターソースの変更を行う、その部分のみをマクロ記録して使う。

 後者がおすすめです。

 それはそうと、

[[20161017233432]] 『マクロ』(パシリ)

 質問をアップされただけど、その後、放置されていますが?

 あと、

[[20161017124529]] 『複数銘柄の中から、銘柄別の抽出方法』(パシリ)

 最後のパシリさんのコメントの後、気になることがあったのでコメントアップしてあります。
 目を通しておいていただければ幸甚。

(β) 2016/10/22(土) 13:08


早速のご回答、また色々ありがとうございます。コメントも入力しているつもりだったのですが不慣れなもので掲示されていませんでした。すみません。
(パシリ) 2016/10/22(土) 13:17

「統合」と「区切り位置」を使ってみました。
 まずは手作業で実施
 次に「マクロの記録」
 その後、記録されたコードを修正していきます。
 この程度ならわたしの場合は手作業だけですますかも。

 1)A列を選んで挿入
 2)挿入された列に、「数式」で店番と顧客番号を連結
 3)「統合」を実行(個数で集計)
 4)店番と顧客番号を「区切り位置」で分割
 6)不要な列を削除

 Option Explicit

 Sub test()
    Dim tbl As Range
    Dim dst As Range

    Columns(1).Insert

    Set tbl = Cells(1).CurrentRegion

    tbl.Resize(, 1).FormulaR1C1 = "=RC[1]&CHAR(9)&RC[2]"

    Set dst = Worksheets.Add.Cells(1)

    tbl.Rows(1).Copy
    dst.PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False

    dst.Consolidate _
            Sources:=tbl.Address(True, True, xlR1C1, True), _
            Function:=xlCount, _
            TopRow:=True, _
            LeftColumn:=True

    Set dst = dst.CurrentRegion.Columns(1)
    dst.Offset(, 1).Resize(, 2).ClearContents

    dst.TextToColumns _
            Destination:=dst.Offset(, 1), _
            DataType:=xlDelimited, _
            Tab:=True, _
            FieldInfo:=Array(Array(1, 2), Array(2, 2))

    dst.Columns(1).Delete Shift:=xlToLeft
    tbl.Columns(1).Delete Shift:=xlToLeft

 End Sub

(マナ) 2016/10/22(土) 15:00


 もう1つ、重複の削除と数式を使った方法を。
 いずれにしても、VBAといえど、エクセル機能を使えるところは、どんどん取り入れてコードを組み立てるのがベストです。
 コードもシンプルになりますし、何よりも、コードとしての実行効率・品質が、自分でゴリゴリとループ処理を書くよりも
 格段に優れたものになります。

 以下の操作をマクロ記録して、あとは、無駄なSelectを取り除けば、そのまま使えます。
 (取り除かなくても使えますが)

 元シートを Sheet1、集計シートを Sheet2 とします。

 1.Sheet2のセルをすべて選択してDeleteキー。(事前にクリアしておきます)
 2.Sheet1のA:C列を選択して Crtl/c --> Sheet2 のA1を選択して Ctrl/v。
 3.この状態で データタブ、重複の削除。保有商品のチェックを外して OKボタン。
 4.Sheet2の C2 を選択して、Ctrl/Shift/↓ 。これで、C2からC列のデータ最終までが選択されます。
 5.この状態で、数式バーに =COUNTIFS(Sheet1!A:A,A2,Sheet1!B:B,B2)
 6.これを Ctrl/Enter で入力します。
 7.もし、結果を値にしておきたければ、この状態で Ctrl/c ---> 形式を選択して貼り付けで 値貼り付け

(β) 2016/10/22(土) 16:56


 ちなみに、↑ でコメントした操作をマクロ記録したものと、それを
 ・無駄なSelectをなくす
 ・領域固定を変数化
 ・マクロ記録では R1C1形式で生成される数式をA1形式に変更
 といったお化粧直しをしたコードを 参考までに。

Sub Macro1()
'
' Macro1 Macro
'

'

    Sheets("Sheet2").Select
    Cells.Select
    Selection.ClearContents
    Sheets("Sheet1").Select
    Columns("A:C").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$C$7").RemoveDuplicates Columns:=Array(1, 2), Header _
        :=xlYes
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "=COUNTIFS(Sheet1!C[-2],RC[-2],Sheet1!C[-1],RC[-1])"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

 Sub Sample()

    With Sheets("Sheet2")
        .Cells.ClearContents
        Sheets("Sheet1").Columns("A:C").Copy .Range("A1")
        .Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2), Header _
            :=xlYes
        With .Range("C2", .Range("C" & Rows.Count).End(xlUp))
            .Formula = "=COUNTIFS(Sheet1!A:A,A2,Sheet1!B:B,B2)"
            .Value = .Value
        End With
    End With
    Application.CutCopyMode = False

 End Sub

(β) 2016/10/22(土) 17:58


色々な方法をご伝授頂きまして、又、初心者にも分かりやすい説明をありがとうございました😊
(パシリ) 2016/10/23(日) 12:05

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.