上月三端电话与直聊贡献成交

Option Explicit

'……………………………………………………………………………………………上月三端电话与直聊贡献成交………………………………………………………………………………………………………………………………………………………
'定义模块级变量
Dim dhwsht As Worksheet, zlwsht As Worksheet, khcfwsht As Worksheet, yjcfwsht As Worksheet
Dim appdhshu As Integer, pcdhshu As Integer, wapdhshu As Integer
Dim appdhkh As Integer, pcdhkh As Integer, wapdhkh As Integer
Dim appzlshu As Integer, pczlshu As Integer, wapzlshu As Integer
Dim appzlkh As Integer, pczlkh As Integer, wapzlkh As Integer
Dim appcfkh As Currency, pccfkh As Currency, wapcfkh As Currency
Dim appcfyj As Currency, pccfyj As Currency, wapcfyj As Currency
Dim and_zls%, ios_zls%, and_zlk%, ios_zlk%
Dim and_zlyeji As Currency, ios_zlyeji As Currency




Sub sanduan()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Call sanduan1
Call sanduan2
Call sanduan3
Call sanduan4

'填入结果表
Dim str5 As String
str5 = Dir("d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\*三端电话与直聊贡献成交.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\" & str5

'填入第一张表R
Sheets("R").Activate
Dim aa As Integer
aa = Range("a500").End(xlUp).Row + 1


If Month(Now()) = 1 Then
Cells(aa, 1) = Format((Year(Now()) - 1) & "/" & "12" & "/" & "1", "yyyy年mm月")
Else
Cells(aa, 1) = Format(Year(Now()) & "/" & Month(Now()) - 1 & "/" & "1", "yyyy年mm月")
End If

Cells(aa, 2) = appdhshu: Cells(aa, 3) = pcdhshu: Cells(aa, 4) = wapdhshu: Cells(aa, 5) = and_zls: Cells(aa, 6) = ios_zls: Cells(aa, 7) = appzlshu: Cells(aa, 8) = pczlshu: Cells(aa, 9) = wapzlshu

Cells(aa, 13) = appdhkh: Cells(aa, 14) = pcdhkh: Cells(aa, 15) = wapdhkh: Cells(aa, 16) = and_zlk: Cells(aa, 17) = ios_zlk: Cells(aa, 18) = appzlkh: Cells(aa, 19) = pczlkh: Cells(aa, 20) = wapzlkh
Cells(aa, 21) = appcfkh: Cells(aa, 22) = pccfkh: Cells(aa, 23) = wapcfkh
Cells(aa, 27) = appcfyj: Cells(aa, 25) = pccfyj: Cells(aa, 26) = wapcfyj

'填入第二张表直聊android/ios业绩
Sheets("直聊android与ios业绩对比").Activate
Dim bb As Integer
bb = Range("a100").End(xlUp).Row + 1
If Month(Now()) = 1 Then
Cells(bb, 1) = Format((Year(Now()) - 1) & "/" & "12" & "/" & "1", "yyyy年mm月")
Else
Cells(bb, 1) = Format(Year(Now()) & "/" & Month(Now()) - 1 & "/" & "1", "yyyy年mm月")
End If

Cells(bb, 2) = and_zlyeji
Cells(bb, 3) = ios_zlyeji

ActiveWorkbook.Close savechanges:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub







''''''''''''''''''''''''''''''''''''''''''''''''''第1步:通数(电话)、通数(直聊)''''''''''''''''''''''''''''''''''''''''''''''''''
Sub sanduan1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'新建专门的计算文档
Workbooks.Add.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\计算暂存", FileFormat:=xlWorkbookDefault
Sheets.Add after:=Sheets(Sheets.Count), Count:=3
Sheets(1).Name = "电话"
Sheets(2).Name = "直聊"
Sheets(3).Name = "客户拆分"
Sheets(4).Name = "业绩拆分"
Set dhwsht = Sheets("电话")
Set zlwsht = Sheets("直聊")
Set khcfwsht = Sheets("客户拆分")
Set yjcfwsht = Sheets("业绩拆分")

'打开上月电信平台的电话表
Dim str1 As String
str1 = Dir("d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\*电信平台*.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\" & str1

'在电话表里筛选所需数据并复制粘贴到计算暂存表
ActiveSheet.UsedRange.AutoFilter field:=12, Criteria1:=Array("APP", "PC", "WAP"), Operator:=xlFilterValues
Union(Columns(3), Columns(12)).Copy
dhwsht.Range("a1").PasteSpecial xlPasteValues
ActiveWorkbook.Close savechanges:=False

'计算三端的电话通数
Application.Goto dhwsht.Range("a1")
appdhshu = Application.WorksheetFunction.CountIf(Columns(2), "APP")
pcdhshu = Application.WorksheetFunction.CountIf(Columns(2), "PC")
wapdhshu = Application.WorksheetFunction.CountIf(Columns(2), "WAP")

'计算三端的电话客户数
Columns("a:b").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
appdhkh = Application.WorksheetFunction.CountIf(Columns(2), "APP")
pcdhkh = Application.WorksheetFunction.CountIf(Columns(2), "PC")
wapdhkh = Application.WorksheetFunction.CountIf(Columns(2), "WAP")



'打开上月直聊总表
Dim str2 As String
str2 = Dir("d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\*直聊总表.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\" & str2
Dim k1 As Byte, kk2 As Range
k1 = Rows(1).Find("平台", lookat:=xlWhole).Column
Set kk2 = Rows(1).Find("大平台", lookat:=xlWhole)

If kk2 Is Nothing Then
Columns(k1 + 1).Insert
Cells(1, k1 + 1) = "大平台"

With Range("f2:f" & Cells(1, 1).End(xlDown).Row)
    .Formula = "=IF(ISNUMBER(SEARCH(""APP"",E2)),""APP"",IF(ISNUMBER(SEARCH(""PC"",E2)),""PC"",IF(ISNUMBER(SEARCH(""WAP"",E2)),""WAP"",""serice"")))"
    .Value = .Value
End With

End If


ActiveSheet.UsedRange.AutoFilter field:=k1 + 1, Criteria1:=Array("APP", "PC", "WAP"), Operator:=xlFilterValues

Union(Columns(1), Columns(k1 + 1), Columns(k1 + 3), Columns(k1 + 4)).Copy

zlwsht.Range("a1").PasteSpecial xlPasteValues

ActiveWorkbook.Close savechanges:=False

'计算三端的直聊通数
Application.Goto zlwsht.Range("a1")

Columns("a:b").Copy Destination:=Range("f1")

Columns("f:g").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
appzlshu = Application.WorksheetFunction.CountIf(Columns("g"), "APP")
pczlshu = Application.WorksheetFunction.CountIf(Columns("g"), "PC")
wapzlshu = Application.WorksheetFunction.CountIf(Columns("g"), "WAP")

'计算三端的直聊客户数
Columns("b:c").Copy Destination:=Range("j1")

Columns("j:k").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
appzlkh = Application.WorksheetFunction.CountIf(Columns("j"), "APP")
pczlkh = Application.WorksheetFunction.CountIf(Columns("j"), "PC")
wapzlkh = Application.WorksheetFunction.CountIf(Columns("j"), "WAP")

'将平台和手机号单独拎出来并去重
Union(Columns("b"), Columns("d")).Copy Destination:=Range("m1")

With Columns("m:n")
    .RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
End With


End Sub








''''''''''''''''''''''''''''''''''''''''''''''''''第2步:客户数(拆分)''''''''''''''''''''''''''''''''''''''''''''''''''
Sub sanduan2()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'将计算暂存文档里直聊表和电话表里平台和手机号两列复制粘贴到[客户拆分表]
Application.Goto zlwsht.Range("a1")
Columns("m").Cut
Columns("o").Insert shift:=xlToRight
'将直聊表里的平台和手机号两列复制到客户拆分表
Columns("m:n").Copy
khcfwsht.Range("a1").PasteSpecial xlPasteValues
Dim k2 As Integer
k2 = Range("n1").End(xlDown).Row

'将电话表里的平台和手机号两列复制到客户拆分表
Application.Goto dhwsht.Range("a1")
Range("a2:b" & Cells(1, 1).End(xlDown).Row).Copy Destination:=khcfwsht.Cells(k2 + 1, 1)

'转到客户拆分表
Application.Goto khcfwsht.Range("a1")
'去重
Range("a:b").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
'将手机号空白行删掉
ActiveSheet.UsedRange.AutoFilter field:=1, Criteria1:=""
Range("a2:d10000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False

Columns("a").Copy Destination:=Range("d1")
Columns("d").RemoveDuplicates Columns:=1, Header:=xlYes
Range("e1:h1") = Array("平台个数", "APP拆分客户数", "PC拆分客户数", "WAP拆分客户数")

Dim k3 As Integer
k3 = Cells(1, 4).End(xlDown).Row

'计算平台个数
With Range("e2:e" & k3)
    .Formula = "=COUNTIF(A:A,d2)"
    .Value = .Value
End With


'计算app拆分客户数
With Range("f2:f" & k3)
    .Formula = "=IF(COUNTIFS($A:$A,$D2,$B:$B,""APP"")>0,1/$E2,0)"
    .Value = .Value
End With
appcfkh = Application.WorksheetFunction.Sum(Columns("f"))
'计算PC拆分客户数
With Range("g2:g" & k3)
    .Formula = "=IF(COUNTIFS($A:$A,$D2,$B:$B,""PC"")>0,1/$E2,0)"
    .Value = .Value
End With
pccfkh = Application.WorksheetFunction.Sum(Columns("g"))
'计算WAP拆分客户数
With Range("h2:h" & k3)
    .Formula = "=IF(COUNTIFS($A:$A,$D2,$B:$B,""WAP"")>0,1/$E2,0)"
    .Value = .Value
End With
wapcfkh = Application.WorksheetFunction.Sum(Columns("h"))

ActiveWorkbook.Save

End Sub















''''''''''''''''''''''''''''''''''''''''''''''''''第3步:业绩(拆分)''''''''''''''''''''''''''''''''''''''''''''''''''

Sub sanduan3()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'将ctm和ptm表里成交编号、业绩、端口三列复制粘贴到计算暂存文档里的业绩拆分表
'将ctm表里所需数据复制粘贴
Dim str3 As String
str3 = Dir("d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\*CTM成交来电数据.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\" & str3
If Month(Now()) = 1 Then
ActiveSheet.UsedRange.AutoFilter field:=11, Criteria1:=">" & Format((Year(Now()) - 1) & "/" & "12/1", "yyyy/mm/dd h:mm:ss")
Else
ActiveSheet.UsedRange.AutoFilter field:=11, Criteria1:=">" & Format(Year(Now()) & "/" & Month(Now()) - 1 & "/" & "1", "yyyy/mm/dd h:mm:ss")
End If

ActiveSheet.UsedRange.AutoFilter field:=21, Criteria1:=Array("*400电话*", "*直聊*"), Operator:=xlFilterValues
ActiveSheet.UsedRange.AutoFilter field:=22, Criteria1:="<>"

Union(Columns(2), Columns(6), Columns(11), Columns(21), Columns(22)).Copy
yjcfwsht.Range("a1").PasteSpecial xlPasteValues
ActiveWorkbook.Close savechanges:=False

Dim k4 As Integer
Application.Goto yjcfwsht.Range("a1")
k4 = Cells(1, 1).End(xlDown).Row


'将ptm表里所需数据复制粘贴
Dim str4 As String
str4 = Dir("d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\*PTM成交来电数据.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\" & str4

ActiveSheet.UsedRange.AutoFilter field:=18, Criteria1:=Array("*400电话*", "*直聊*"), Operator:=xlFilterValues
ActiveSheet.UsedRange.AutoFilter field:=19, Criteria1:="<>"

Union(Columns("b:c"), Columns("g"), Columns(18), Columns(19)).Copy
yjcfwsht.Range("j1").PasteSpecial xlPasteValues
ActiveWorkbook.Close savechanges:=False

Columns("l").Cut
Columns("k").Insert shift:=xlToRight

Range("j2:n" & Range("j2").End(xlDown).Row).Copy

Cells(k4 + 1, 1).PasteSpecial xlPasteValues
Columns("i:o").Delete
Range("c2:c" & Cells(1, 3).End(xlDown).Row).NumberFormat = "yyyy/mm/dd h:mm:ss"

'计算直聊andorid与ios的业绩
Union(Columns(1), Columns(2), Columns(4), Columns(5)).Copy Destination:=Range("j1")
Range("j1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes

and_zlyeji = Application.WorksheetFunction.SumIfs(Range("k:k"), Range("l:l"), "中原网-直聊", Range("m:m"), "APP_ANDROID_APUSH")

ios_zlyeji = Application.WorksheetFunction.SumIfs(Range("k:k"), Range("l:l"), "中原网-直聊", Range("m:m"), "APP_IOS_APUSH")
Range("j1").CurrentRegion.Clear


Union(Columns(1), Columns(2), Columns(5)).Copy Destination:=Range("j1")

Range("m1") = "合并端口"
With Range("m2:m" & Range("j1").End(xlDown).Row)
    .Formula = "=if(isnumber(search(""APP"",l2)),""APP"",if(isnumber(search(""WAP"",l2)),""WAP"",""PC""))"
    .Value = .Value
End With

Columns("l").Delete
    

Range("j:l").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes

'拆分
Columns("j:k").Copy Destination:=Range("o1")
Range("o:p").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
Range("q1:t1") = Array("平台个数", "APP拆分业绩", "PC拆分业绩", "WAP拆分业绩")
Dim k5 As Integer
k5 = Range("o1").End(xlDown).Row
'计算平台个数
With Range("q2:q" & k5)
    .Formula = "=countif(j:j,o2)"
    .Value = .Value
End With
'计算APP拆分业绩
With Range("r2:r" & k5)
    .Formula = "=IF(COUNTIFS($j:$j,$o2,$l:$l,""APP"")>0,$p2/$q2,0)"
    .Value = .Value
End With
appcfyj = Application.WorksheetFunction.Sum(Columns("r"))
    
'计算PC拆分业绩
With Range("s2:s" & k5)
    .Formula = "=IF(COUNTIFS($j:$j,$o2,$l:$l,""PC"")>0,$p2/$q2,0)"
    .Value = .Value
End With
pccfyj = Application.WorksheetFunction.Sum(Columns("s"))

'计算WAP拆分业绩
With Range("t2:t" & k5)
    .Formula = "=IF(COUNTIFS($j:$j,$o2,$l:$l,""WAP"")>0,$p2/$q2,0)"
    .Value = .Value
End With
wapcfyj = Application.WorksheetFunction.Sum(Columns("t"))

ActiveWorkbook.Close savechanges:=True


End Sub












''''''''''''''''''''''''''''''''''''''''''''''''''第4步:计算android和ios端的直聊，数与客''''''''''''''''''''''''''''''''''''''''''''''''''


Sub sanduan4()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim zlstr As String

'打开月度直聊表并定义
zlstr = Dir("d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\*直聊总表.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月Apppcwap三端电话与直聊贡献成交\" & zlstr
Dim zlst As Worksheet
Set zlst = ActiveSheet


'匹配出细分端口
Columns("f").Insert
Range("f1") = "大平台"
Dim zlk As Long
zlk = Range("a1").End(xlDown).Row

With Range(Range("f2"), Cells(zlk, 6))
    .Formula = "=IF(ISNUMBER(SEARCH(""PC"",e2)),""PC"",IF(ISNUMBER(SEARCH(""WAP"",e2)),""WAP"",IF(ISNUMBER(SEARCH(""ANDROID"",e2)),""ANDROID"",IF(ISNUMBER(SEARCH(""IOS"",e2)),""IOS"",e2))))"
    .Value = .Value
End With

'新建一个名为“暂存”的表
Worksheets.Add.Name = "暂存"


'计算android直聊量、ios直聊量,android直聊客户数、ios直聊客户数
zlst.Activate
Union(Columns(1), Columns(6)).Copy Destination:=Sheets("暂存").Range("a1")
Union(Columns(6), Columns(8)).Copy Destination:=Sheets("暂存").Range("e1")
 
Sheets("暂存").Activate
Union(Columns(1), Columns(2)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
and_zls = Application.WorksheetFunction.CountIf(Range("b:b"), "ANDROID")
ios_zls = Application.WorksheetFunction.CountIf(Range("b:b"), "IOS")

 Union(Columns(5), Columns(6)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
 and_zlk = Application.WorksheetFunction.CountIf(Range("e:e"), "ANDROID")
 ios_zlk = Application.WorksheetFunction.CountIf(Range("e:e"), "IOS")
 
 ActiveWorkbook.Close savechanges:=False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub