实战 | Excel伴侣-数据库篇

'***************************************************
'*作    者：liuxiangtao
'*发布版本：Ver2.0
'*发布日期：2019-07-15  初版作成
'*更新日期：2019-07-17  默认起止日期由当前日期改为前一天
'*更新日期：2019-07-19  自动去除重复数据
'*更新日期：2019-08-01  险种类别为健康险的订单区分长短期
'*更新日期：2019-09-10  解决第一行订单数据的处理遗漏问题
'**************************************
Dim duplicateDataSum As Integer  '统计重复数据数量
Dim DataSum As Long   '统计总订单数
Dim Startdate As String, Enddate As String
Public Const removeReferer As String = "'218.244.x.241','115.29.x.203','112.124.x.48','120.27.x.221'" '排除内部Ip




 Function OrderMatomo()
    '异常处理句柄
    On Error GoTo Err_Handle 
    '每次新查询订单数据，判断"订单统计"和"渠道统计"sheet是否存在的开关
    Dim flag1 As Boolean, flag2 As Boolean
    
    MsgBox ("温馨提示：8:30以后才能统计到前一天的全部数据")
    Startdate = Form_date.ComboBox1.Value & Form_date.ComboBox2.Value & Form_date.ComboBox3.Value
    Enddate = Form_date.ComboBox6.Value & Form_date.ComboBox5.Value & Form_date.ComboBox4.Value 
    flag1 = False
    flag2 = False
    '日期有效性检验
    If Len(Startdate) <> 8 Or Len(Enddate) <> 8 Then
        MsgBox ("请输入起止日期！")
        Exit Function
    End If 
    Form_date.Hide
    MsgBox ("温馨提示：当日期较长，数据量较大时，速度会变慢甚至会卡死，" & Chr(10) & "可缩短查询时长或者分批次查询来解决！" & Chr(10) & "如果你对此感到好奇，你可以试试到底多长时间的数据会导致体验极速下降！")
    '判断是否存在打开的工作簿，0表示不存在
     If Workbooks.Count = 0 Then
line:
            '新建一个工作簿，并添加表头
            Workbooks.Add
            ActiveSheet.Name = "渠道订单详情"          
            Range("A1:Q1").Value = Array("投保日期", "星期", "具体时间", "地点", "来源类型", "推广来源", "推广计划", "推广单元", "推广词", "推广创意", "流量来源", "关键词", "订单号", "收益", "产品编码", "产品名称", "险种类别")




    '当前存在打开的工作簿
     Else
        For i = 1 To ActiveWorkbook.Sheets.Count
            If Sheets(i).Name = "渠道统计" Then
                flag1 = True
            ElseIf Sheets(i).Name = "产品统计" Then
                flag2 = True
            ElseIf Sheets(i).Name = "渠道订单详情" Then
                Sheets("渠道订单详情").Activate
            End If
        Next i
        
        Set thisActiveSheet = ActiveWorkbook.ActiveSheet
        '判断是否为待生成报表的格式
        If thisActiveSheet.Cells(1, 1).Value = "投保日期" And thisActiveSheet.Cells(1, 11).Value = "流量来源" And thisActiveSheet.Cells(1, 17).Value = "险种类别" Then
            '清空以前的内容
            ActiveWorkbook.Worksheets("渠道订单详情").Range(Cells(2, 1), Cells(50000, 17)).ClearContents
        '若不是
        Else
            '执行前面的代码创建
            GoTo line
        End If
        
        '每次重新查询新的订单数据，需要把原来的渠道统计和产品统计结果删除
        If flag1 = True Then
            Sheets("渠道统计").Delete
        End If        
        If flag2 = True Then
            Sheets("产品统计").Delete
        End If
    End If
     '关闭屏幕刷新
    Application.ScreenUpdating = False
    
    '定义mysql数据源（需要先在本地安装驱动及创建好数据源）
     Dim oConn As New ADODB.Connection
     '连接mysql数据库
     oConn.ConnectionString = "Driver={MySQL ODBC 8.0 Unicode Driver};Server=rm-bp179ar5909n2w4qjpx.mysql.rds.aliyuncs.com;PORT=3306;DB=matomo;UID=rept;PWD=Aa$$;OPTION=3;"
     oConn.Open
     '判断是否能够正常连接数据库
      If oConn.State <> 1 Then
            Set oConn = Nothing
            MsgBox "数据库联接失败！"
            Exit Function
      End If
     
    '定义sql语句变量
    Dim strSQL As String
    '初始化
    strSQL = ""
    '待执行sql语句  *20190801增加长短健康险区分sql
    strSQL = "SELECT DATE_FORMAT(DATE_ADD(a.server_time,INTERVAL 8 HOUR),'%Y-%m-%d') AS 投保日期,concat('星期',DATE_FORMAT(a.server_time,'%w')) as 星期,DATE_FORMAT(DATE_ADD(a.server_time,INTERVAL 8 HOUR),'%T') AS 具体时间,"
    strSQL = strSQL & "b.location_city as 城市,(case b.referer_type  when '1' then '直入'  when '2' then '搜索' when '3' then '网站' when '6' then '推广' else '其它' end) as '来源类型',"
    strSQL = strSQL & "b.campaign_source AS '推广来源',b.campaign_medium AS '推广计划',b.referer_name AS 推广单元,b.referer_keyword AS 推广词,b.campaign_content AS 推广创意,"
    strSQL = strSQL & "  (case b.referer_type when '6' then '' else b.referer_name end) as 来源名称,(case b.referer_type when '6' then '' else b.referer_keyword end) as 关键词,"
    strSQL = strSQL & "a.idorder AS 订单号,b.revenue AS 收益,(SELECT NAME FROM ma_log_action WHERE idaction = a.idaction_sku) AS 产品编码,(SELECT NAME FROM ma_log_action WHERE idaction = a.idaction_name) AS 产品名称,"
    strSQL = strSQL & " case when(SELECT product_category   FROM    ma_log_action d,ma_product_info f   WHERE   d.idaction = a.idaction_sku and d.name = f.product_code ) IS null "
    strSQL = strSQL & " THEN (SELECT c.name FROM    ma_log_action c WHERE   c.idaction = a.idaction_category) else  "
    strSQL = strSQL & "  (SELECT product_category    FROM ma_log_action d,ma_product_info f  WHERE   d.idaction = a.idaction_sku and d.name = f.product_code) end  as '险种类别'"
    strSQL = strSQL & " FROM ma_log_conversion_item a,ma_log_conversion b WHERE a.idorder = b.idorder and "
    strSQL = strSQL & " DATE_FORMAT(DATE_ADD(a.server_time,INTERVAL 8 HOUR),'%Y%m%d') >='" & Startdate & "' AND DATE_FORMAT(DATE_ADD(a.server_time,INTERVAL 8 HOUR),'%Y%m%d') <='" & Enddate & "'"
    strSQL = strSQL & " and (b.referer_name is null or  b.referer_name not in (" & removeReferer & " ))"
    strSQL = strSQL & " order by 投保日期,订单号,推广来源"




    'Cells(1, 10).Value = strSQL
    '定义数据源执行结果对象
    Dim rstMain  As ADODB.Recordset
    Set rstMain = New ADODB.Recordset
    '执行sql获取结果，adLockOptimistic表示执行过程中，数据可以正常操作
    rstMain.Open strSQL, oConn, 3, 3
    'Cells(1, 17).Value = strSQL
    '显示进度条
    Call ShowPercent
    '数据非空判断
    If rstMain.EOF Then
            MsgBox "没有查询到任何数据！"
            Exit Function
    Else
        '将查询结果，从A2开始放置到当前的excel中（比一条条的处理效率大幅提升）
        Range("A2").CopyFromRecordset rstMain
        '列宽度自动调整
        Columns("A:E").Select
        Columns("A:E").EntireColumn.AutoFit
        Columns("M:Q").Select
        Columns("M:Q").EntireColumn.AutoFit
    End If
    
    '关闭数据库连接
    rstMain.Close: Set rstMain = Nothing
    oConn.Close: Set oConn = Nothing
    '重复数据处理
    Call DeleteduplicateData
    '格式化
    Call sheetFormate(ActiveSheet, "A", "Q", 1, 50000)
    '打开屏幕刷新
    Application.ScreenUpdating = True
    '焦点定位到文件首
    Cells(1, 1).Select
    
    '完成提醒
    MsgBox ("好了，" & "且已处理" & duplicateDataSum & "条重复数据，谢谢使用")
    Exit Function
    
Err_Handle:
        MsgBox ("未知错误，请联系工具制作者")
End Function




'***************************************************************************
'功能：去除重复数据行
'参数：无
'更新  20190802  健康险分长短期;来源网站明显是搜索的归集到搜索渠道
'更新  20190802  矫正遗漏的搜索和微信来源订单
'更新  20190809  流量分类精准化处理
'更新  20190821  解决最后一条订单数据流量分类不处理的问题
'更新  20190906  针对第一条数据流量划分不准确的问题处理
'***************************************************************************
Sub DeleteduplicateData()
    Dim i As Long, jkFlag As Boolean, SerarchE() As Variant, WeixinOther() As Variant, Zhihu() As Variant
    duplicateDataSum = 0
    i = 2
    jkFlag = False
    
    '搜索引擎
    SerarchE = Array("m.baidu.com", "www.baidu.com", "www.so.com", "m.so.com", "www.sogou.com", "m.sogou.com", "www.google.com", "m.google.com", "yz.m.sm.cn", "m.sm.cn")
    '微信特征
    WeixinOther = Array("wechat_session", "wechat_timeline", "wx", "微信")
    '知乎特征
    Zhihu = Array("zhhd", "hd", "zhwz", "wz", "zhpl", "pl")
    '关闭屏幕刷新
    Application.ScreenUpdating = False
    Do
        '搜索引擎来源矫正
        For Each se In SerarchE
            If Cells(i, 11).Value = se Then
                Cells(i, 5) = "SEO"
                Cells(i, 6) = "网站"
            End If
        Next
        If Cells(i, 5).Value = "搜索" Then
               Cells(i, 5) = "SEO"
               Cells(i, 6) = "搜索"
        End If
        '微信自带特征——推广来源非空
        For Each wo In WeixinOther
            If Cells(i, 6).Value = wo Then
                Cells(i, 5) = "微信"
            End If
        Next
        '微信自带特征——推广来源为微信或推广词末尾为wx或推广单元是wechat_session
        If LCase(Right(Cells(i, 9).Value, 2)) = "wx" Or Cells(i, 8).Value = "wechat_session" Then
            Cells(i, 5).Value = "微信"
        End If
        'SEM特征——推广单元末尾为pc或yd
        If Right(Cells(i, 8).Value, 2) = "pc" Or Right(Cells(i, 8).Value, 2) = "yd" Then
            Cells(i, 5).Value = "SEM"
        End If
        '品专特征——推广词末尾为kxb 或流量来源为sp0.baidu.com
        If Right(Cells(i, 9).Value, 3) = "kxb" Or Cells(i, 11).Value = "sp0.baidu.com" Or Cells(i, 11).Value = "bzclk.baidu.com" Then
            Cells(i, 5).Value = "品专"
        End If
        '知乎特征——推广单元为"zhhd", "hd", "zhwz", "wz", "zhpl", "pl" 或流量来源是知乎
        For Each zh In Zhihu
            If Cells(i, 8).Value = zh Then
                Cells(i, 5) = "知乎"
            End If
        Next
        If Cells(i, 11).Value = "知乎" Or Cells(i, 11).Value = "link.zhihu.com" Then
            Cells(i, 5) = "知乎"
        End If
        '新上健康险未入库产品甄选
        If Cells(i, 17).Value = "健康保险" Then
            jkFlag = True
        End If
        
        '删除重复数据，只留最后一条
        If Cells(i + 1, 13).Value = Cells(i, 13).Value And Cells(i + 1, 14).Value = Cells(i, 14).Value And Cells(i + 1, 16).Value = Cells(i, 16).Value Then
            duplicateDataSum = duplicateDataSum + 1
            Rows(i & ":" & i).Select
            Selection.Delete Shift:=xlUp
        Else
            i = i + 1
        End If
    Loop Until Cells(i + 1, 1).Value = ""
    
    If jkFlag = True Then
            MsgBox ("存在新上的健康险但未入库，无法自动区分长期还是短期，请联系工具制作者！")
    End If
End Sub