BDAstyle

ビジネスデータ分析ツールの作成 with Excel

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

2.顧客の振り分け

方法2 マクロによる方法

この方法について

セグメントごとに27枚のシートを作成し,先に作ったRFM分析表から各セグメントに該当する顧客を適切なシートに振り分ける…という,手作業では手間のかかる作業を自動的におこなうものです。出力はあたらしいブックを作成しておこないますので,先に作ったRFM分析表のデータには影響しません。

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

初期データ

免責および特記事項

Step 1VBE(Visual Basic Editor)の起動(1)

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

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

Step 2VBE(Visual Basic Editor)の起動(2)

VBEが起動します。

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

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

Step 4VBEの操作・VBAコードの導入(2) 「標準モジュール」ウインドウ

「標準モジュール」ウインドウが表示されます。

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

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

Sub RFMclassify()

' *** RFMセグメントに顧客を振り分け ver.1.2.1
' *** R,F,M各3クラスを設定した場合の, 計27個のセグメントにデータを振り分けるマクロです。
' *** 元表は掲載の表と同じ体裁を整えている必要があります。
' *** 詳細は当該ページ(http://bdastyle.net/tools/rfm-analysis/page3.html)をご覧ください。
' *** BDAstyle(http://bdastyle.net/)
' *** 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 6VBEの操作・VBAコードの導入(4) コードの貼り付け

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

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

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

Step 8マクロの実行(1)

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

Step 9マクロの実行(2)

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

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

Step 10RFMセグメント 振り分けの完了

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

シート名の数字は,左から,R・F・Mの各クラスの得点をあらわしています。各シートには,R・F・Mの各クラスの得点に対応するID(顧客)が振り分けられています。また,右方の数字は当該セグメントの顧客構成比です。

その他の参照