常见模型介绍客户价值分析RFM模型2

　　谈完了思路，咱们来说一下实现的细节。如何在WPS实现这些功能。实现这些功能的方法有两种，一种是使用数据透视表公式，一种是VBA。第一种方式实现门槛比较低，就是操作繁琐，需要手动操作和刷新，如果是非日常的工作可以使用，但要是日常工作的话或者数据量较大的会比较麻烦计算速度慢，这样的情况下我建议使用VBA，一键完成，自动化省时省力。
　　咱们先来说一下第一种方法。首先是选择明细表中的源数据，点击插入数据透视表，选择新建数据透视表。
　　然后在数据透视表中，行选择客户编号，值添加交易金额，值字段设置为求和；值添加客户编号，值字段设置为计数；值添加交易时间，值字段设置为最大值，数字格式设置为日期。
　　设置好的效果应该是如下图：
　　第二步是借助公式，计算客户最近一次交易距指定日期的时间。这里首先在某个单元格里写入指定日期，然后如下图编写公式：
　　然后，选择数据中最后一行按下shiftctrl键，然后点击数据第一行，选择区域后点击行和列填充向下填充，然后利用min、max、Percentile三个函数计算各个分位数。然后利用IFS函数对每个用户进行打分。这个公式就比较长了。
　　最终效果如下图：
　　现在，咱们再来说一下如何用VBA实现。废话不多说先贴核心代码：
　　SetcnnCreateObject（adodb。connection）
　　cnn。OpenProviderMicrosoft。jet。OLEDB。4。0；ExtendedPropertiesExcel8。0；DataSourceThisWorkbook。FullName
　　SetrsCreateObject（adodb。recordset）
　　Sqlselect客户编号，count（客户编号）as交易次数，sum（交易金额）as交易总额，max（交易时间）as最近交易from〔明细表〕groupby客户编号
　　Setrscnn。Execute（Sql）执行查询
　　ThisWorkbook。Sheets（统计表）。Cells（2，1）。CopyFromRecordsetrs
　　这一段代码是利用VBA中的JET库使用SQL语句进行统计，一句话完成了和数据透视表一样的功能。下一步是计算最近交易时间到指定日期的天数，是通过以下代码实现的。
　　tp2ThisWorkbook。Sheets（统计表）。Cells（1，8）
　　Fori2Totlong
　　tpThisWorkbook。Sheets（统计表）。Cells（i，4）
　　ThisWorkbook。Sheets（统计表）。Cells（i，5）DateDiff（d，tp，tp2）
　　Next
　　然后我们通过以下的代码求分位数并利用for循环进行打分。
　　WithThisWorkbook。Sheets（统计表）
　　。Cells（4，8）Application。Min（Range（B：B））
　　。Cells（5，8）Application。WorksheetFunction。Percentile（Range（B：B），0。2）
　　。Cells（6，8）Application。WorksheetFunction。Percentile（Range（B：B），0。4）
　　。Cells（7，8）Application。WorksheetFunction。Percentile（Range（B：B），0。5）
　　。Cells（8，8）Application。WorksheetFunction。Percentile（Range（B：B），0。6）
　　。Cells（9，8）Application。WorksheetFunction。Percentile（Range（B：B），0。8）
　　。Cells（10，8）Application。Max（Range（B：B））
　　。Cells（4，9）Application。Min（Range（c：c））
　　。Cells（5，9）Application。WorksheetFunction。Percentile（Range（c：c），0。2）
　　。Cells（6，9）Application。WorksheetFunction。Percentile（Range（c：c），0。4）
　　。Cells（7，9）Application。WorksheetFunction。Percentile（Range（c：c），0。5）
　　。Cells（8，9）Application。WorksheetFunction。Percentile（Range（c：c），0。6）
　　。Cells（9，9）Application。WorksheetFunction。Percentile（Range（c：c），0。8）
　　。Cells（10，9）Application。Max（Range（c：c））
　　。Cells（10，10）Application。Min（Range（E：E））
　　。Cells（9，10）Application。WorksheetFunction。Percentile（Range（E：E），0。2）
　　。Cells（8，10）Application。WorksheetFunction。Percentile（Range（E：E），0。4）
　　。Cells（7，10）Application。WorksheetFunction。Percentile（Range（E：E），0。5）
　　。Cells（6，10）Application。WorksheetFunction。Percentile（Range（E：E），0。6）
　　。Cells（5，10）Application。WorksheetFunction。Percentile（Range（E：E），0。8）
　　。Cells（4，10）Application。Max（Range（E：E））
　　Fori2Totlong
　　t10
　　t20
　　t30
　　t40
　　If（。Cells（i，2）。Cells（5，8））Then
　　t11
　　ElseIf（。Cells（i，2）。Cells（6，8））Then
　　t12
　　ElseIf（。Cells（i，2）。Cells（8，8））Then
　　t13
　　ElseIf（。Cells（i，2）。Cells（9，8））Then
　　t14
　　Else
　　t15
　　EndIf
　　If（。Cells（i，3）。Cells（5，9））Then
　　t21
　　ElseIf（。Cells（i，3）。Cells（6，9））Then
　　t22
　　ElseIf（。Cells（i，3）。Cells（8，9））Then
　　t23
　　ElseIf（。Cells（i，3）。Cells（9，9））Then
　　t24
　　Else
　　t25
　　EndIf
　　If（。Cells（i，4）。Cells（9，10））Then
　　t35
　　ElseIf（。Cells（i，4）。Cells（8，10））Then
　　t34
　　ElseIf（。Cells（i，4）。Cells（6，10））Then
　　t33
　　ElseIf（。Cells（i，4）。Cells（5，10））Then
　　t32
　　Else
　　t31
　　EndIf
　　t4（t1t2t3）3
　　。Cells（i，6）（t1t2t3）3
　　Next
　　。Cells（4，11）Application。Min（Range（F：F））
　　。Cells（5，11）Application。WorksheetFunction。Percentile（Range（F：F），0。2）
　　。Cells（6，11）Application。WorksheetFunction。Percentile（Range（F：F），0。4）
　　。Cells（7，11）Application。WorksheetFunction。Percentile（Range（F：F），0。5）
　　。Cells（8，11）Application。WorksheetFunction。Percentile（Range（F：F），0。6）
　　。Cells（9，11）Application。WorksheetFunction。Percentile（Range（F：F），0。8）
　　。Cells（10，11）Application。Max（Range（F：F））
　　EndWith
　　最后的效果如下图：
　　好了，今天就说到这里，如果觉得我写的不错，请关注我的公众号行思知识工坊吧！后续还会有更多的文章的。