RFM分析［顧客購買履歴(利用実績)］ with Excel 3/3

IDをセグメントの別に振り分ける

［方法2］マクロによる方法

セグメントの別に27枚のシートを作成したうえで，先に作ったRFM分析表のRFMスコアを参照し，ID別に適切なシートに振り分けるという，手作業では手間のかかる作業を自動的におこなうためのマクロです。出力はあたらしいブックを作成しておこないます。ゆえに先に作ったRFM分析表のデータには影響しません。

シートを切り替えることで各セグメントをさくさくと眺めていくことができます。

免責および特記事項

このマクロはあくまでデモンストレーションを目的としたものです。コードをそのままご利用いただく場合には，お手持ちのデータで従前の方法にて作成したものと内容を照合し，おかしな点が出現しないかどうかを安全な環境で十分に確認してください。精度の不足あるいは予期しないデータ消失等のトラブルにつきまして，筆者は一切責任を負いかねます。
「RFM分析［顧客購買履歴(利用実績)］ with Excel　1/3」で作成したRFM分析表の構成でのみ正常に動作します。分析表のセル番地がそれと異なるものでは使用できません。
R, F, M各3クラスの組み合わせで，計27のセグメントによる分類のみ可能です。
あたらしいブックの初期シート数について，Excel2010の場合は3枚，Excel2013の場合は1枚の設定でのみ正常に動作します(いずれもデフォルトの設定です)。
数百～数千件のレコード数(=ID数)を想定しています。レコード数が大きくなれば，当然27セグメントでの運用が適切かどうかの検討も要します。
マクロの動作自体の検証(お使いの環境で正常に動作するか，あるいは処理にどの程度の時間がかかるかといったことの確認)には，このテストデータをExcelにコピペしてお使いいただけます。万一動作中に固まった場合は，[Ctrl]キー＋[Pause/Break]キーをお試しください。

Step 1VBE(Visual Basic Editor)の起動

「RFM分析［顧客購買履歴(利用実績)］ with Excel　1/3」で作成したRFM分析表を用意します。このRFM分析表を必ずアクティブな状態にしておきます。

開発タブ「コード」グループのVisual Basicボタンをクリックします。

Step 2VBEの操作・VBAコードの導入(1)

VBEの挿入メニュー標準モジュールをクリックします。

Step 3VBEの操作・VBAコードの導入(2)　コードのコピー

次のコードをすべて選択し，コピーします。

Sub RFMclassify()

' RFMセグメントに顧客を振り分け v16.0214
' bdastyle.net/tools/rfm-analysis/page3.html
' by hawcas 2012, 2014, 2016

On Error GoTo myError

Dim rec As Variant  ' レコード数
Dim id() As String  ' ID
Dim rS() As Long    ' Recency Score
Dim fS() As Long    ' Frequency Score
Dim mS() As Long    ' Monetary Score
Dim wbNam As String ' あたらしいブック名
Dim shtNam(27) As String    ' 作成するシート名
Dim sht As Long
Dim cr As Double    ' 構成比
Dim i As Long       ' 以下カウンタ
Dim r As Long
Dim f As Long
Dim m As Long

    ' レコード数のカウント
    rec = ActiveSheet.Range("A3").CurrentRegion.Rows.Count - 1
    ' 配列
    ReDim id(rec - 1)
    ReDim rS(rec - 1, 0)
    ReDim fS(rec - 1, 0)
    ReDim mS(rec - 1, 0)
    ' アクティブシートのデータを配列に格納
    For i = 0 To rec - 1
        id(i) = ActiveSheet.Cells(4, 8).Offset(0 + i, 0).Value
        rS(i, 0) = ActiveSheet.Cells(4, 9).Offset(0 + i, 0).Value
        fS(i, 0) = ActiveSheet.Cells(4, 10).Offset(0 + i, 0).Value
        mS(i, 0) = ActiveSheet.Cells(4, 11).Offset(0 + i, 0).Value
    Next
    ' あたらしいワークブックの追加
    Workbooks.Add
    ' 追加したワークブックの名前を取得
    wbNam = ActiveWorkbook.Name
    ' シートを追加(計27枚作成)
    If Application.Version >= 15 Then
        sht = 26    ' ver.2013以降デフォルト
    Else
        sht = 24    ' ver.2010以前デフォルト
    End If
    For i = 1 To sht
       Worksheets.Add
    Next
    ' クラスごとにシート名を作成(“RFMx-x-x”というルールで)
    i = 1
    For r = 1 To 3
        For f = 1 To 3
            For m = 1 To 3
                shtNam(i) = "RFM" & r & "-" & f & "-" & m
                i = i + 1
            Next
        Next
    Next
    ' シート名を変更
    For i = 1 To 27
        Worksheets(i).Name = shtNam(28 - i)
    Next
    ' 見出しの作成
    For i = 1 To 27
        Workbooks(wbNam).Sheets(i).Cells(1, 1).Value = "ID"
        Workbooks(wbNam).Sheets(i).Cells(1, 2).Value = "R"
        Workbooks(wbNam).Sheets(i).Cells(1, 3).Value = "F"
        Workbooks(wbNam).Sheets(i).Cells(1, 4).Value = "M"
    Next
    ' データを当該クラスのシートへ振り分け
    For i = 0 To rec - 1
        r = rS(i, 0)
        f = fS(i, 0)
        m = mS(i, 0)
        Workbooks(wbNam).Sheets("RFM" & r & "-" & f & "-" & m).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = id(i)
        Workbooks(wbNam).Sheets("RFM" & r & "-" & f & "-" & m).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = rS(i, 0)
        Workbooks(wbNam).Sheets("RFM" & r & "-" & f & "-" & m).Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = fS(i, 0)
        Workbooks(wbNam).Sheets("RFM" & r & "-" & f & "-" & m).Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = mS(i, 0)
    Next
    ' 構成比の計算
    For r = 1 To 3
        For f = 1 To 3
            For m = 1 To 3
                cr = (Workbooks(wbNam).Sheets("RFM" & r & "-" & f & "-" & m).Range("A1").CurrentRegion.Rows.Count - 1) / rec
                    With Workbooks(wbNam).Sheets("RFM" & r & "-" & f & "-" & m).Range("F2")
                        .Value = cr
                        .NumberFormatLocal = "0.00%"
                    End With
            Next
        Next
    Next
    Exit Sub

myError:
   MsgBox "実行時エラーが発生しました。処理を終了します。"

End Sub

Step 4VBEの操作・VBAコードの導入(3)　コードの貼り付け

「標準モジュール」ウインドウにコードを貼り付けます。

Step 5VBEの操作・VBAコードの導入(4)

閉じるボタンをクリックしてVBEを閉じます。

Step 6マクロの実行(1)

開発タブ「コード」グループのマクロボタンをクリックします。

Step 7マクロの実行(2)

「マクロ」ダイアログが表示されます。

マクロ名に「RFMclassify」(このマクロの名前)が表示されていることを確認して，実行ボタンをクリックします。

Step 8振り分け完了

あたらしいブックが用意され，そのブックに27枚のシートが自動的に差し込まれます。27枚のシートには，「3-3-3」～「1-1-1」までセグメントが網羅的に割り当てられます。

シート名の数字は，左から，R・F・Mの各スコアをあらわしています。各シートには，R・F・Mスコアと対応するID(顧客)が振り分けられています。また，右方の数字は当該セグメントに属するIDの割合です。

その他の参照

このサイトの関連How-toです。

メインサイト「ひとりマーケティングのためのデータ分析」のクラス管理ツールに関するHow-toです。

Home

BDAstyle

Business Data Analysis & Visualization with Excel

RFM分析［顧客購買履歴(利用実績)］ with Excel 3/3

IDをセグメントの別に振り分ける

［方法2］マクロによる方法

免責および特記事項

Step 1VBE(Visual Basic Editor)の起動

Step 2VBEの操作・VBAコードの導入(1)

Step 3VBEの操作・VBAコードの導入(2)　コードのコピー

Step 4VBEの操作・VBAコードの導入(3)　コードの貼り付け

Step 5VBEの操作・VBAコードの導入(4)

Step 6マクロの実行(1)

Step 7マクロの実行(2)

Step 8振り分け完了

その他の参照

RFM分析［顧客購買履歴(利用実績)］ with Excel 3/3

IDをセグメントの別に振り分ける

［方法2］マクロによる方法

免責および特記事項

Step 1VBE(Visual Basic Editor)の起動

Step 2VBEの操作・VBAコードの導入(1)

Step 3VBEの操作・VBAコードの導入(2) コードのコピー

Step 4VBEの操作・VBAコードの導入(3) コードの貼り付け

Step 5VBEの操作・VBAコードの導入(4)

Step 6マクロの実行(1)

Step 7マクロの実行(2)

Step 8振り分け完了

その他の参照

Step 3VBEの操作・VBAコードの導入(2)　コードのコピー

Step 4VBEの操作・VBAコードの導入(3)　コードの貼り付け