daily report
锺离马鲁
Option Explicit
'定义模块级变量(结果类)
Dim zcshu%, zcdate As Date, wtshu As Integer, wtkf As Integer, wtdate As Date, ykkf As Integer, ykshu As Integer, wycall%, wydate As Date, zllines As Integer, zlkf As Integer, zlshu%, pcshu%, zlxfshu%, zlxfkf%, zlpckf%, zlsysshu%, zlsyskf%, zldate As Date, dhstr As String, zlstr As String, wystr As String, wtstr As String, restr As String, zlwapshu%, zlwapkf%, sinashu%, sinasuc%, chenshu%, chensuc%, dongfangshu%, dongfangsuc%, newcount%, and_zlshu%, ios_zlshu%, and_zlk%, ios_zlk%, ttflshu%, ttflsuc%
Sub ribao()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Call rb
Call xinfang
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
'***************************************************************************************日报数据****************************************************************************************
'................................................................电话数据............................................................................................
Sub rb()
'关闭屏幕更新和提示
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'取出并定义电话原表名称
dhstr = Dir("d:\Users\zhanggl21\Desktop\6666\日报\日话明细*.xls", vbNormal)
'打开匹配表和电信平台数据
Workbooks.Open Filename:="E:\lele月工作记录\数据匹配与高级筛选201712updated.xlsx"
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\" & dhstr
'定义变量
Dim rng1 As Range, wht1 As Worksheet
Set wht1 = Workbooks(dhstr).Worksheets(1)
'将文本型号码转换为数字型
With Range("c2:c" & Range("a56566").End(xlUp).Row)
.NumberFormat = "general"
.Value = .Value
End With
'删除屏蔽号码－在客户号码列右边插入辅助列，用以填充匹配屏蔽号码的公式
Columns("d").Insert
Range("D1") = "清洗"
'在辅助列填入匹配屏蔽号码的公式
With Range("D2:D" & Range("a56566").End(xlUp).Row)
.NumberFormat = "general"
.Formula = "=VLOOKUP(C2,[数据匹配与高级筛选201712updated.xlsx]内部屏蔽号码20180104updated!$A$2:$A$60000,1,0)"
.Value = .Value
End With
'筛选出包含屏蔽号码的记录并删除
ActiveSheet.UsedRange.AutoFilter field:=4, Criteria1:=">0", Operator:=xlFilterValues
Range("a2:x56566").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
'让程序跳出自动筛选状态
ActiveSheet.AutoFilterMode = False
'删除辅助列
Columns("d").Delete
'删除客户号码以"215178"开头的记录
ActiveSheet.UsedRange.AutoFilter field:=3, Criteria1:=">=2151780000", Criteria2:="<=2151789999"
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
ActiveSheet.AutoFilterMode = False
'根据分机号匹配出平台
'把文本型分机号码转换成数字，在分机号右边插入辅助列并匹配出类型
Dim rng3 As Range
'将文本型分机号转换为数字型
With Range("j2:j" & Cells(1, 1).End(xlDown).Row)
.NumberFormat = "general"
.Value = .Value
End With
'插入新列(分机号列右边)
Columns("k").Insert
Range("k1").Value = "分类"
'填入匹配公式
Range("k2").Select
With Range("k2:k" & Cells(1, 1).End(xlDown).Row)
.Formula = "=IF(OR(AND(J2>=100000,J2<=449999),AND(J2>=900000,J2<=949999),AND(J2>=970000,J2<=979999)),""PC"",IF(AND(J2>=450000,J2<=799999,J2<>666666,J2<>66666),""WAP"",IF(AND(J2>=800000,J2<=899999),""APP"",IF(AND(J2>=950000,J2<=959999),""工商铺"",IF(AND(J2>=960000,J2<=969999),""新房"",IF(OR(J2=666666,J2=66666),""活动专线"",IF(J2=888888,""888888"",0)))))))"
.Value = .Value
End With
'筛选出用户名称列不为空的记录
Range("k2").Select
ActiveSheet.UsedRange.AutoFilter field:=2, Criteria1:="上海中原"
'计算各平台来电量
'将分类列在用户名称不为空的记录复制并粘贴到新建的计数表
Columns("k").Copy
Worksheets.Add
ActiveSheet.Name = "计数暂存"
ActiveSheet.Paste
'定义各平台结果为变量并赋值
Dim pccount%, wapcount%, appcount%, shopcount%, hdcount%, ffcount%, efcall%, succount%, yesdate As Date
pccount = Application.WorksheetFunction.CountIf(Columns("a"), "PC")
wapcount = Application.WorksheetFunction.CountIf(Columns("a"), "WAP")
appcount = Application.WorksheetFunction.CountIf(Columns("a"), "APP")
shopcount = Application.WorksheetFunction.CountIf(Columns("a"), "工商铺")
newcount = Application.WorksheetFunction.CountIf(Columns("a"), "新房")
hdcount = Application.WorksheetFunction.CountIf(Columns("a"), "活动专线")
ffcount = Application.WorksheetFunction.CountIf(Columns("a"), "888888")
'删除计数表
Sheets("计数暂存").Delete
'关闭匹配文档(不保存)
Workbooks("数据匹配与高级筛选201712updated.xlsx").Close savechanges:=False
'计算成功接通的电话量
'删除计数表并在电话表里对通话结果为"成功"的记录进行计数
Range("a2").Select
Selection.AutoFilter
succount = Application.WorksheetFunction.CountIf(Columns("g"), "成功")
'计算总电话量
Dim totalcall%
totalcall = Range("a5656").End(xlUp).Row - 1
'计算总客户
Dim totalkf%
Columns("c").Copy
Worksheets.Add
ActiveSheet.Name = "计数暂存"
ActiveSheet.Paste
Columns("a").RemoveDuplicates Columns:=1, Header:=xlYes
totalkf = Sheets("计数暂存").Range("a5656").End(xlUp).Row - 1
Sheets("计数暂存").Delete
'计算日期
yesdate = Format(Sheets(1).Range("h2"), "yyyy/mm/dd")
'计算有效来电量
efcall = pccount + wapcount + appcount + shopcount + newcount + hdcount + ffcount
'计算新房客户
Dim newkf%
If newcount = 0 Then
newkf = 0
ElseIf newcount = 1 Then
newkf = 1
Else
ActiveSheet.UsedRange.AutoFilter field:=11, Criteria1:="新房"
Columns("C:C").Copy
Worksheets.Add
ActiveSheet.Name = "计数暂存"
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$10485").RemoveDuplicates Columns:=1, Header:=xlYes
newkf = Application.WorksheetFunction.CountA(Columns(1)) - 1
Sheets("计数暂存").Delete
End If
'退出自动筛选状态
ActiveSheet.UsedRange.AutoFilter
'计算来电有效客户
Dim efkf%
ActiveSheet.UsedRange.AutoFilter field:=2, Criteria1:="上海中原"
Columns("C:C").Copy
Worksheets.Add
ActiveSheet.Name = "计数暂存"
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$10485").RemoveDuplicates Columns:=1, Header:=xlYes
efkf = Application.WorksheetFunction.CountA(Columns(1)) - 1
Sheets("计数暂存").Delete
ActiveSheet.UsedRange.AutoFilter
'计算陈国军电话量及成功接通量
chenshu = Application.WorksheetFunction.CountIfs(Columns("i"), "4008193118", Columns("j"), "<>8")
chensuc = Application.WorksheetFunction.CountIfs(Columns("i"), "4008193118", Columns("j"), "<>8", Columns("g"), "成功")
'关闭电话表(保存)
Workbooks(dhstr).Close savechanges:=True
'................................................................运行其它数据过程，并把结果汇总到日报结果表............................................................................................
Call wangyi
Call register
Call weituo
Call yuekan
Call zhiliao
'填入日报汇总表
Workbooks.Open Filename:="E:\lele月工作记录\日报\日报汇总updating.xlsx"
'填电话数据
Sheets("来电量").Activate
Dim kshu As Integer
kshu = Range("a5656").End(xlUp).Row + 1
Range("a" & kshu) = yesdate
Range("b" & kshu) = totalcall
Range("c" & kshu) = totalkf
Range("d" & kshu) = efcall
Range("e" & kshu) = efkf
Range("g" & kshu) = appcount
Range("h" & kshu) = pccount
Range("i" & kshu) = wapcount
Range("j" & kshu) = hdcount
Range("k" & kshu) = newcount
Range("l" & kshu) = shopcount
Range("m" & kshu) = ffcount
Range("o" & kshu) = succount
Range("p" & kshu) = newkf
Range("f" & kshu) = Format(succount / efcall, "percent")
'填注册委托约看数据
Sheets("日注册").Activate
Dim lshu As Integer
lshu = Range("a5656").End(xlUp).Row + 1
Range("a" & lshu) = yesdate
Range("b" & lshu) = zcshu
Range("c" & lshu) = wtshu
Range("d" & lshu) = wtkf
Range("e" & lshu) = ykshu
Range("f" & lshu) = ykkf
'填网易数据
Sheets("网易").Activate
Dim jshu As Integer
jshu = Range("a5656").End(xlUp).Row + 1
Range("a" & jshu) = wydate
Range("b" & jshu) = wycall
'填直聊数据
Sheets("直聊").Activate
Dim mshu As Integer
mshu = Range("a5656").End(xlUp).Row + 1
Range("a" & mshu) = zldate
Range("b" & mshu) = zlshu
Range("c" & mshu) = and_zlshu
Range("d" & mshu) = ios_zlshu
Range("f" & mshu) = pcshu
Range("g" & mshu) = zlwapshu
Range("h" & mshu) = zlxfshu
Range("i" & mshu) = zlkf
Range("k" & mshu) = and_zlk
Range("l" & mshu) = ios_zlk
Range("m" & mshu) = zlpckf
Range("n" & mshu) = zlwapkf
Range("o" & mshu) = zlxfkf
Range("p" & mshu) = zllines
Range("t" & mshu) = zlsysshu
Range("u" & mshu) = zlsyskf
'新房每日来电表，填入日期
Sheets("新房每日来电").Activate
Range("a5689").End(xlUp).Offset(1, 0) = yesdate
'在alipay表里填入新浪乐居、陈国军、懂房帝、头条福利、支付宝租房电话数据
Sheets("alipay").Activate
With Range("a5689").End(xlUp)
.Offset(1, 0) = yesdate
.Offset(1, 1) = sinashu
.Offset(1, 2) = sinasuc
.Offset(1, 4) = chenshu
.Offset(1, 5) = chensuc
.Offset(1, 7) = dongfangshu
.Offset(1, 8) = dongfangsuc
.Offset(1, 10) = ttflshu
.Offset(1, 11) = ttflsuc
End With
'涉及费用表/不涉及费用表，填入日期
Sheets("涉及费用").Activate
Range("a5689").End(xlUp).Offset(1, 0) = yesdate
Sheets("不涉及费用").Activate
Range("a5689").End(xlUp).Offset(1, 0) = yesdate
'填去重客户
'计算直聊客户手机号去重
Dim zlsjshu%
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\" & zlstr
Sheets("Sheet0").Activate
Columns(Cells.Find("手机号", lookat:=xlWhole).Column).Copy Destination:=Range("z1")
Columns("z").Select
Selection.RemoveDuplicates Columns:=1, Header:=xlYes
zlsjshu = Range("z10000").End(xlUp).Row - 2
Workbooks("日报汇总updating.xlsx").Sheets("去重").Columns("a:f").ClearContents
Workbooks("日报汇总updating.xlsx").Sheets("去重").Range("a1") = yesdate
'将直聊客户手机号复制到去重表
Range("z1:z" & Range("z10000").End(xlUp).Row).Copy Destination:=Workbooks("日报汇总updating.xlsx").Sheets("去重").Range("a10000").End(xlUp).Offset(1, 0)
Workbooks(zlstr).Close savechanges:=True
'计算注册客户手机号去重
Dim zcsjshu%
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\" & restr
Columns("c").Copy Destination:=Range("z1")
Columns("z").RemoveDuplicates Columns:=1, Header:=xlYes
zcsjshu = Range("z10000").End(xlUp).Row - 2
Range("z2:z" & Range("z10000").End(xlUp).Row).Copy Destination:=Workbooks("日报汇总updating.xlsx").Sheets("去重").Range("a10000").End(xlUp).Offset(1, 0)
Workbooks(restr).Close savechanges:=True
'将委托客户的手机号粘贴到去重表
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\" & wtstr
If Not Rows("1").Find("业主电话", lookat:=xlPart) Is Nothing Then
Columns(Rows("1").Find("业主电话", lookat:=xlWhole).Column).Copy Destination:=Range("z1")
Columns("z").RemoveDuplicates Columns:=1, Header:=xlYes
Range("z2:z" & Range("z10000").End(xlUp).Row).Copy Destination:=Workbooks("日报汇总updating.xlsx").Sheets("去重").Range("a10000").End(xlUp).Offset(1, 0)
Workbooks(wtstr).Close savechanges:=True
Else
Workbooks(wtstr).Close savechanges:=True
End If
'将电话客户的手机号粘贴到去重表
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\" & dhstr
Columns(Cells.Find("主叫", lookat:=xlWhole).Column).Copy Destination:=Range("z1")
Columns("z").RemoveDuplicates Columns:=1, Header:=xlYes
Range("z2:z" & Range("z10000").End(xlUp).Row).Copy Destination:=Workbooks("日报汇总updating.xlsx").Sheets("去重").Range("a10000").End(xlUp).Offset(1, 0)
Workbooks(dhstr).Close savechanges:=True
'对所有手机号去重
Dim allsjshu%
Workbooks("日报汇总updating.xlsx").Sheets("去重").Activate
Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes
allsjshu = Range("a10000").End(xlUp).Row - 2
'填入去重数据
Workbooks("日报汇总updating.xlsx").Sheets("汇总").Activate
Dim oshu As Integer
oshu = Range("a1000").End(xlUp).Offset(1, 0).Row
Cells(oshu, 1) = yesdate
Range("l" & oshu) = yesdate
Range("t" & oshu) = zlsjshu
Range("u" & oshu) = zcsjshu
Range("v" & oshu) = allsjshu
Workbooks("日报汇总updating.xlsx").Close savechanges:=True
'打开屏幕更新和提示状态
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
'................................................................直聊数据............................................................................................
Sub zhiliao()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'取出并定义直聊原表名称
zlstr = Dir("d:\Users\zhanggl21\Desktop\6666\日报\聊天信息*.xls", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\" & zlstr
'定义直聊表
Dim zlwht1 As Worksheet
Set zlwht1 = Sheets(1)
'删除首行无用标题
Rows(1).Delete
'删除黑名单记录
ActiveSheet.UsedRange.AutoFilter field:=13, Criteria1:="是"
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
ActiveSheet.UsedRange.AutoFilter
Columns("m").Delete
'删除聊天记录包含"测试"的记录
Worksheets.Add
ActiveSheet.Name = "计数暂存"
Range("a1").Value = "聊天记录"
Range("a2").Value = "*测试*"
zlwht1.Activate
Dim zlrng1 As Range
Set zlrng1 = Columns("l").Find("测试", LookIn:=xlValues)
If Not zlrng1 Is Nothing Then
zlwht1.Activate
ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=Sheets("计数暂存").Range("a1:a2")
Columns("a").Copy Destination:=Sheets("计数暂存").Range("c1")
zlwht1.Activate
ActiveSheet.UsedRange.AutoFilter
zlwht1.Range("a2").Select
ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=Sheets("计数暂存").Range("c1:c" & Sheets("计数暂存").Range("c5656").End(xlUp).Row)
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
'退出筛选状态
ActiveSheet.UsedRange.AutoFilter
zlwht1.AutoFilterMode = False
End If
'删除包含屏蔽号码的记录
'将文本型客户号码转换为数字型,同时匹配出屏蔽号码(统计设置为6666)
Workbooks.Open Filename:="E:\lele月工作记录\数据匹配与高级筛选201712updated.xlsx"
Workbooks(zlstr).Activate
Dim zlk As Integer
zlk = Rows("1").Find("手机号", lookat:=xlWhole).Column
'将文本型手机号转换为数字型
With Range(Cells(2, zlk), Cells(Cells(1, 1).End(xlDown).Row, zlk))
.NumberFormat = "general"
.Value = .Value
End With
'插入新列并匹配出屏蔽号码
Columns(zlk + 1).Insert
Cells(1, zlk + 1).Value = "清洗"
With Range(Cells(2, zlk + 1), Cells(Cells(1, 1).End(xlDown).Row, zlk + 1))
.NumberFormat = "general"
.Formula = "=vlookup(g2,[数据匹配与高级筛选201712updated.xlsx]内部屏蔽号码20180104updated!$A$2:$A$60000,1,0)"
.Value = .Value
End With
'删除包含屏蔽号码的记录
ActiveSheet.UsedRange.AutoFilter field:=zlk + 1, Criteria1:=">0"
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
zlwht1.AutoFilterMode = False
'删除清洗辅助列
Columns(zlk + 1).Delete
'删除无效日期的记录
Columns("c").Insert
Range("c1") = "日期"
With Range("c2:c" & Cells(1, 1).End(xlDown).Row)
.NumberFormat = "general"
.Formula = "=int(b2)"
.Value = .Value
End With
Range("a2").Select
ActiveSheet.UsedRange.Sort key1:=Range("b11"), order1:=xlAscending, Header:=xlYes, Orientation:=xlTopToBottom
ActiveSheet.UsedRange.AutoFilter field:=3, Criteria1:="<>" & Format(Range("b100"), "yyyy-mm-dd")
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
zlwht1.AutoFilterMode = False
'将记录粘贴至直聊总表
Workbooks.Open Filename:="E:\lele月工作记录\数据更新\直聊&约看&400\直聊总表.xlsx"
Dim xy As Long
xy = Range("a1").End(xlDown).Row + 1
zlwht1.Activate
ActiveSheet.Rows("2:" & Range("a50000").End(xlUp).Row).Copy Destination:=Workbooks("直聊总表.xlsx").Sheets(1).Cells(xy, 1)
Workbooks("直聊总表.xlsx").Close savechanges:=True
'新建一列，匹配出细分平台
zlwht1.Activate
Columns("f").Insert
Range("f1") = "大平台"
With Range("f2:f" & Cells(1, 1).End(xlDown).Row)
.NumberFormat = "general"
.Formula = "=IF(ISNUMBER(SEARCH(""ANDROID"",E2)),""ANDROID"",IF(ISNUMBER(SEARCH(""IOS"",E2)),""IOS"",IF(ISNUMBER(SEARCH(""WAP"",E2)),""WAP"",IF(ISNUMBER(SEARCH(""PC"",E2)),""PC"",E2))))"
.Value = .Value
End With
'计算总聊天条数
'Dim zllines As Integer
zllines = Range("a56565").End(xlUp).Row - 1
'计算总客户数
'Dim zlkf As Integer
Columns("h").Copy Destination:=Sheets("计数暂存").Range("e1")
Sheets("计数暂存").Activate
Columns("e").RemoveDuplicates Columns:=1, Header:=xlYes
zlkf = Application.WorksheetFunction.CountA(Columns("e")) - 1
'计算总通数,app端通数、pc端通数、系统触发直聊总通数
zlwht1.Activate
Union(Columns(1), Columns(3), Columns(6)).Select
Selection.Copy Destination:=Sheets("计数暂存").Range("g1")
Sheets("计数暂存").Activate
Columns("g:i").Select
Selection.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
pcshu = Application.WorksheetFunction.CountIf(Columns("i"), "PC")
and_zlshu = Application.WorksheetFunction.CountIf(Columns("i"), "ANDROID")
ios_zlshu = Application.WorksheetFunction.CountIf(Columns("i"), "IOS")
zlwapshu = Application.WorksheetFunction.CountIf(Columns("i"), "WAP")
zlsysshu = Application.WorksheetFunction.CountIf(Columns("i"), "SERVICE_PUSH")
zlshu = pcshu + and_zlshu + ios_zlshu + zlsysshu + zlwapshu
'计算新房频道通数,新房频道客户数
Dim zlrng2 As Range
zlwht1.Activate
Set zlrng2 = Columns("g").Find("xinfang*", LookIn:=xlValues)
If Not zlrng2 Is Nothing Then
ActiveSheet.UsedRange.AutoFilter field:=7, Criteria1:="xinfang*"
Union(Columns(1), Columns(8)).Select
Selection.Copy Destination:=Sheets("计数暂存").Range("m1")
Sheets("计数暂存").Activate
Columns("n").Insert
Columns("m").Select
Selection.RemoveDuplicates Columns:=1, Header:=xlYes
zlxfshu = Application.WorksheetFunction.CountA(Columns("m")) - 1
Columns("o").Select
Selection.RemoveDuplicates Columns:=1, Header:=xlYes
zlxfkf = Application.WorksheetFunction.CountA(Columns("o")) - 1
Else
zlxfshu = 0
zlxfkf = 0
End If
'计算app端客户数、pc端客户数、系统触发客户数
zlwht1.Activate
zlwht1.AutoFilterMode = False
Union(Columns(6), Columns(8)).Select
Selection.Copy Sheets("计数暂存").Range("r1")
Sheets("计数暂存").Activate
Columns("r:s").Select
Selection.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
and_zlk = Application.WorksheetFunction.CountIf(Columns("r"), "ANDROID")
ios_zlk = Application.WorksheetFunction.CountIf(Columns("r"), "IOS")
zlpckf = Application.WorksheetFunction.CountIf(Columns("r"), "PC")
zlwapkf = Application.WorksheetFunction.CountIf(Columns("r"), "WAP")
zlsyskf = Application.WorksheetFunction.CountIf(Columns("r"), "SERVICE_PUSH")
'计算日期
'Dim zldate As Date
zlwht1.Activate
ActiveSheet.AutoFilterMode = False
zldate = Format(Range("b2"), "yyyy/mm/dd")
Workbooks("数据匹配与高级筛选201712updated.xlsx").Close savechanges:=False
Workbooks(zlstr).Close savechanges:=True
End Sub
'................................................................网易数据............................................................................................
Sub wangyi()
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'取出并定义网易表名称
wystr = Dir("d:\Users\zhanggl21\Desktop\6666\日报\CallLogs*.xls", vbNormal)
'定义网易表
Dim wywht1 As Worksheet
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\" & wystr
Set wywht1 = Workbooks(wystr).Sheets(1)
'激活网易表
wywht1.Activate
Range("a1").Select
'删除无效日期(可能存在其它无效日期)
Columns("c").Insert
Range("c1").Value = "日期"
Range("c2").Select
'填入匹配公式
With Range("c2:c" & Cells(1, 1).End(xlDown).Row)
.Formula = "=int(b2)"
.NumberFormat = "yyyy/mm/dd"
.Value = .Value
End With
'删除包含无效日期无记录
Dim nowdate As Date
nowdate = DateSerial(2018, 1, 1)
Range("c2").Select
'筛选出无效日期记录
ActiveSheet.UsedRange.AutoFilter field:=3, Criteria1:="<" & nowdate
'删除无效日期记录
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
'退出自动筛选状态
ActiveSheet.UsedRange.AutoFilter
'删除包含屏蔽号码的记录
'打开匹配文档，激活网易表
Workbooks.Open Filename:="E:\lele月工作记录\数据匹配与高级筛选201712updated.xlsx"
wywht1.Activate
'插入新列(辅助清洗)
Columns("l").Insert
Range("l1").Value = "清洗"
'将要填入公式的单元格格式设置为文本格式
With Range("l2:l" & Cells(1, 1).End(xlDown).Row)
.NumberFormat = "general"
.Formula = "=vlookup(k2,[数据匹配与高级筛选201712updated.xlsx]内部屏蔽号码20180104updated!$A$2:$A$60000,1,0)"
.Value = .Value
End With
'关闭匹配文档(不保存)
Workbooks("数据匹配与高级筛选201712updated.xlsx").Close savechanges:=False
'筛选出包含屏蔽号码的记录
wywht1.UsedRange.AutoFilter field:=12, Criteria1:=">0", Operator:=xlFilterValues
'删除包含屏蔽号码的记录
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
ActiveSheet.AutoFilterMode = False
Columns("l").Delete
'删除包含以"215178"开头的客户号码的记录
ActiveSheet.UsedRange.AutoFilter
ActiveSheet.UsedRange.AutoFilter field:=11, Criteria1:=">=2151780000", Criteria2:="<=2151789999"
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
ActiveSheet.UsedRange.AutoFilter
'给结果变量赋值
wycall = Application.WorksheetFunction.CountIf(Columns("i"), "qd=163")
wydate = Format(Range("c2"), "yyyy/mm/dd")
'记录懂房帝电话量
dongfangshu = Application.WorksheetFunction.CountIf(Columns("i"), "sem=toutiao")
dongfangsuc = Application.WorksheetFunction.CountIfs(Columns("i"), "sem=toutiao", Columns("q"), "成功")
'记录头条福利电话量
ttflshu = Application.WorksheetFunction.CountIf(Columns("i"), "sem=TouTiaoXingFuLi")
ttflsuc = Application.WorksheetFunction.CountIfs(Columns("i"), "sem=TouTiaoXingFuLi", Columns("q"), "成功")
'记录支付宝租房电话量
ActiveSheet.UsedRange.AutoFilter field:=9, Criteria1:=Array("sem=alipay", "sem=sina"), Operator:=xlFilterValues
Union(Columns(9), Columns(17)).Copy
ActiveSheet.AutoFilterMode = False
Worksheets.Add.Name = "计数暂存"
[a1].PasteSpecial xlPasteValues
[c1] = "成功通话"
With Range("c2:c" & Range("a655").End(xlUp).Row)
.FormulaR1C1 = "=RC[-2]&RC[-1]"
.Value = .Value
End With
'alipayshu = Application.WorksheetFunction.CountIf(Columns(1), "sem=alipay")
sinashu = Application.WorksheetFunction.CountIf(Columns(1), "sem=sina")
'alipaysuc = Application.WorksheetFunction.CountIf(Columns(3), "sem=alipay成功")
sinasuc = Application.WorksheetFunction.CountIf(Columns(3), "sem=sina成功")
'关闭暂存和网易表(保存)
Sheets("计数暂存").Delete
Workbooks(wystr).Close savechanges:=True
End Sub
'................................................................注册用户数据............................................................................................
Sub register()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'取出并定义注册原表名称
restr = Dir("d:\Users\zhanggl21\Desktop\6666\日报\userInformation*.xls", vbNormal)
Workbooks.Open Filename:="E:\lele月工作记录\数据匹配与高级筛选201712updated.xlsx"
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\" & restr
Dim zcrng1 As Range
'将文本型手机号转换为数字型
With Range("c2:c" & Cells(1, 1).End(xlDown).Row)
.NumberFormat = "general"
.Value = .Value
End With
'删除包含屏蔽号码的记录
Columns("d").Insert
Range("d1").Value = "清洗"
With Range("d2:d" & Cells(1, 1).End(xlDown).Row)
.NumberFormat = "general"
.Formula = "=vlookup(c2,[数据匹配与高级筛选201712updated.xlsx]内部屏蔽号码20180104updated!$A$2:$A$60000,1,0)"
.Value = .Value
End With
ActiveSheet.UsedRange.AutoFilter field:=4, Criteria1:=">0", Operator:=xlFilterValues
Range("a2:x10000").Delete shift:=xlUp
ActiveSheet.UsedRange.AutoFilter
Columns("d").Delete
zcshu = Application.WorksheetFunction.CountA(Columns(1)) - 1
zcdate = Format(Range("a2"), "yyyy/mm/dd")
Workbooks(restr).Close savechanges:=True
Workbooks("数据匹配与高级筛选201712updated.xlsx").Close savechanges:=False
End Sub
'................................................................委托数据............................................................................................
Sub weituo()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'取出并定义委托原表名称
wtstr = Dir("d:\Users\zhanggl21\Desktop\6666\日报\entrustManage*.xls", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\" & wtstr
Dim wtsht1 As Worksheet
Set wtsht1 = Workbooks(wtstr).Sheets(1)
wtsht1.Activate
'判断表是否为空，如果为空直接跳出
If Application.WorksheetFunction.CountA(Range("a1")) = 0 Then
wtkf = 0
wtshu = 0
wtdate = zcdate
Workbooks(wtstr).Close savechanges:=True
Else
'删除测试记录
Dim jkl As String, kkl As Integer, kkj As Integer
jkl = Replace(Rows("1").Find("业主电话", lookat:=xlWhole).Address(0, 0), "1", "")
kkl = Rows("1").Find(what:="业主姓名", lookat:=xlPart).Column
For kkj = Cells(10000, kkl).End(xlUp).Row To 2 Step -1
If InStr(1, Cells(kkj, kkl), "测试") Then
Rows(kkj).Delete
End If
Next
'将文本型业主电话转换为数字型
With Range(jkl & "2", jkl & Cells(1, 1).End(xlDown).Row)
.NumberFormat = "general"
.Value = .Value
End With
wtsht1.Columns(jkl).Copy
Worksheets.Add
ActiveSheet.Name = "计数暂存"
ActiveSheet.Paste
Columns("a").RemoveDuplicates Columns:=1, Header:=xlYes
wtkf = Range("a56566").End(xlUp).Row - 1
Sheets("计数暂存").Delete
wtsht1.Activate
wtshu = Range("a56566").End(xlUp).Row - 1
wtdate = Format(Range("b2"), "yyyy/mm/dd")
Workbooks(wtstr).Close savechanges:=True
End If
End Sub
'................................................................约看数据............................................................................................
Sub yuekan()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\中原网约看报表-单项条件查询.xlsx"
If Application.CountA(Rows("2")) = 0 Then Rows("1:2").Delete: Columns("a").Delete
If Range("a2") = "" Then
ykshu = 0: ykkf = 0
Else
Dim yksht1 As Worksheet
Set yksht1 = Workbooks("中原网约看报表-单项条件查询.xlsx").Sheets(1)
'删除测试记录
Dim ii As Integer, mn As Integer
ii = Rows("1").Find(what:="客户姓名", lookat:=xlPart).Column
For mn = Cells(100, ii).End(xlUp).Row To 2 Step -1
If InStr(1, Cells(mn, ii), "测试") Then
Rows(mn).Delete
End If
Next
Columns(Rows("1").Find("客户ID", lookat:=xlWhole).Column).Copy
Worksheets.Add.Name = "计数暂存"
[a1].PasteSpecial xlPasteValues
'去重计数
ActiveSheet.UsedRange.Interior.Color = RGB(220, 220, 220)
ActiveSheet.UsedRange.RemoveDuplicates Columns:=1, Header:=xlYes
ykkf = Application.WorksheetFunction.CountA(Columns(1)) - 1
Sheets("计数暂存").Delete
yksht1.Activate
ykshu = Range("b5656").End(xlUp).Row - 1
End If
Workbooks("中原网约看报表-单项条件查询.xlsx").Close savechanges:=True
End Sub
'................................................................新房数据............................................................................................
Sub xinfang()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'新建一个暂存文档并命名3张表
Workbooks.Add.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\日报\暂存.xlsx", FileFormat:=xlWorkbookDefault
ActiveSheet.Name = "新房电话"
Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "新房直聊"
Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "新房电话直聊汇总"
'打开当天已处理完毕的电话表并提取相关数据到新建文档的新房电话表
If newcount > 0 Then
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\CallLogs.xls"
ActiveSheet.UsedRange.AutoFilter field:=8, Criteria1:="上海项目部"
Union(Columns(1), Columns(2), Columns(6), Columns(7), Columns(11), Columns(17)).Copy Destination:=Workbooks("暂存.xlsx").Sheets("新房电话").Range("a1")
ActiveWorkbook.Close savechanges:=False
End If
'打开当天已处理完毕的直聊表并提取相关数据到新建文档的新房直聊表
If zlxfkf > 0 Then
'将当天的新房直聊明细另存为新文档
Workbooks.Add.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\日报\新房直聊明细.xlsx", FileFormat:=xlWorkbookDefault
Dim zlstr As String
zlstr = Dir("d:\Users\zhanggl21\Desktop\6666\日报\聊天信息*.xls", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\日报\" & zlstr
ActiveSheet.UsedRange.AutoFilter field:=7, Criteria1:="xinfang_loupan"
ActiveSheet.UsedRange.Copy Destination:=Workbooks("新房直聊明细.xlsx").Sheets(1).Range("a1")
Workbooks("新房直聊明细.xlsx").Close savechanges:=True
Union(Columns(1), Columns(12), Columns(13), Columns(15), Columns(16)).Copy Destination:=Workbooks("暂存.xlsx").Sheets("新房直聊").Range("a1")
ActiveWorkbook.Close savechanges:=False
End If
'处理新房电话和新房直聊数据
If zlxfkf > 0 Or newcount > 0 Then
Workbooks.Open Filename:="E:\lele月工作记录\数据更新\新房每日来电&每月成交情况汇总-updating.xlsx"
Sheets("电话直聊每日接通情况").Activate
Dim mmn As Integer
mmn = Range("d20000").End(xlUp).Row + 1
Workbooks("暂存.xlsx").Activate
Application.Goto Sheets("新房电话").Range("a1")
'处理新房电话数据
If Application.WorksheetFunction.CountA(Range("a:a")) > 1 Then
Application.Goto Workbooks("新房每日来电&每月成交情况汇总-updating.xlsx").Sheets("项目每日电话情况及责任人明细").Range("a1")
Dim bmn As Integer
bmn = Range("a10000").End(xlUp).Row + 1
Application.Goto Workbooks("暂存.xlsx").Sheets("新房电话").Range("a1")
Columns("d").Insert
Range("d1") = "项目名称"
'提取楼盘名称
With Range("d2:d" & Cells(100, 1).End(xlUp).Row)
.Formula = "=MID(C2,SEARCH(""-"",C2,10)+1,10)"
.Value = .Value
End With
Columns("c").Delete
'匹配出接通状态
Dim k As Integer
k = Cells(1, 1).End(xlToRight).Column
Cells(1, k + 1) = "是否成功接通"
With Range(Cells(2, k + 1), Cells(Cells(100, 1).End(xlUp).Row, k + 1))
.Formula = "=if(f2<>""成功"",""失败"",""成功"")"
.Value = .Value
End With
Columns("f").Delete
Columns("e:g").Insert
With Columns("d")
.TextToColumns DataType:=xlDelimited, other:=True, Space:=True
End With
Range("d1") = "负责人电话"
Range("e1") = "负责人姓名"
Range("f1") = "负责人工号"
Columns("g").Delete
'电话量 电话成功接通数 电话未接通 电话接通率
Dim i As Integer, nn As Integer
i = Cells(1, 1).End(xlToRight).Column
nn = Cells(100, 1).End(xlUp).Row
Cells(1, i + 1) = "电话量"
Cells(1, i + 2) = "电话成功接通数"
Cells(1, i + 3) = "电话未接通"
Cells(1, i + 4) = "电话接通率"
'电话量
With Range(Cells(2, i + 1), Cells(nn, i + 1))
.Formula = "=countif(c:c,c2)"
.Value = .Value
End With
'电话成功接通数
With Range(Cells(2, i + 2), Cells(nn, i + 2))
.Formula = "=countifs(h:h,""成功"",c:c,c2)"
.Value = .Value
End With
'电话未接通数
With Range(Cells(2, i + 3), Cells(nn, i + 3))
.Formula = "=countifs(h:h,""<>成功"",c:c,c2)"
.Value = .Value
End With
'电话接通率
With Range(Cells(2, i + 4), Cells(nn, i + 4))
.Formula = "=j2/i2"
.Value = .Value
.NumberFormat = "0%"
End With
'将新房电话记录复制到新房数据的电话表
Range(Range("b2"), Cells(nn, 8)).Copy Destination:=Workbooks("新房每日来电&每月成交情况汇总-updating.xlsx").Sheets("项目每日电话情况及责任人明细").Cells(bmn, 3)
Columns("c").Copy Destination:=Sheets("新房电话直聊汇总").Range("a1")
End If
'处理新房直聊数据
Application.Goto Sheets("新房直聊").Range("a1")
If Application.WorksheetFunction.CountA(Columns(1)) > 1 Then
Workbooks.Open Filename:="E:\lele月工作记录\数据匹配与高级筛选201712updated.xlsx"
Application.Goto Workbooks("暂存.xlsx").Sheets("新房直聊").Range("a1")
ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
Dim krow As Integer, kcol As Integer
krow = Range("a1000").End(xlUp).Row
kcol = Range("a1").End(xlToRight).Column
Cells(1, kcol + 1) = "直聊通数"
Cells(1, kcol + 2) = "直聊有回复的通数"
Cells(1, kcol + 3) = "直聊无回复的通数"
Cells(1, kcol + 4) = "直聊回复率"
'直聊通数列
With Range(Cells(2, kcol + 1), Cells(krow, kcol + 1))
.Formula = "=countif(c:c,c2)"
.Value = .Value
End With
'直聊有回复的通数列
With Range(Cells(2, kcol + 2), Cells(krow, kcol + 2))
.Formula = "=countifs(c:c,c2,d:d,"">0"")"
.Value = .Value
End With
'直聊无回复的通数列
With Range(Cells(2, kcol + 3), Cells(krow, kcol + 3))
.Formula = "=countifs(c:c,c2,d:d,0)"
.Value = .Value
End With
'直聊回复率列
With Range(Cells(2, kcol + 4), Cells(krow, kcol + 4))
.Formula = "=g2/f2"
.Value = .Value
.NumberFormat = "0%"
End With
'根据房源编号匹配出楼盘名称
Columns("d").Insert
With Range(Cells(2, 3), Cells(krow, 3))
.NumberFormat = "general"
.Value = .Value
End With
Cells(1, 4) = "楼盘名称"
With Range(Cells(2, 4), Cells(krow, 4))
.Formula = "=vlookup(C2,[数据匹配与高级筛选201712updated.xlsx]新房楼盘匹配!$A$2:$b$6000,2,0)"
.Value = .Value
End With
Workbooks("数据匹配与高级筛选201712updated.xlsx").Close savechanges:=False
End If
'处理新房电话直聊汇总
'Dim kcall As Integer, kzhiliao As Integer
'Application.Goto Workbooks("暂存.xlsx").Sheets("新房电话").Range("a1")
'kcall = Application.WorksheetFunction.CountA(Columns(1))
' Application.Goto Workbooks("暂存.xlsx").Sheets("新房直聊").Range("a1")
' kzhiliao = Application.WorksheetFunction.CountA(Columns(1))
'88888888888888888888888888888888888888888888888888888888888888888888888888888888888888上面完全运行，重要标记
Application.Goto Workbooks("暂存.xlsx").Sheets("新房直聊").Range("a1")
If Application.WorksheetFunction.CountA(Columns(1)) > 0 Then
Range(Cells(2, 4), Cells(krow, 4)).Copy
Application.Goto Workbooks("暂存.xlsx").Sheets("新房电话直聊汇总").Range("a1")
Cells(1, 1) = "项目名称"
Cells(Range("a100").End(xlUp).Row + 1, 1).PasteSpecial xlPasteValues
End If
Application.Goto Workbooks("暂存.xlsx").Sheets("新房电话直聊汇总").Range("a1")
Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes
Dim mk As Integer
mk = Range("a100").End(xlUp).Row
Cells(1, 1) = "项目名称"
Cells(1, 2) = "电话量"
Cells(1, 3) = "电话成功接通数"
Cells(1, 4) = "电话未接通"
Cells(1, 5) = "电话接通率"
Cells(1, 6) = "直聊量"
Cells(1, 7) = "直聊有回复"
Cells(1, 8) = "直聊无回复"
Cells(1, 9) = "直聊回复率"
'匹配电话量
With Range(Cells(2, 2), Cells(mk, 2))
.Formula = "=IF(ISERROR(VLOOKUP(A2,新房电话!C:L,7,0)),0,VLOOKUP(A2,新房电话!C:L,7,0))"
.Value = .Value
End With
'匹配电话成功接通数
With Range(Cells(2, 3), Cells(mk, 3))
.Formula = "=IF(ISERROR(VLOOKUP(A2,新房电话!C:L,8,0)),0,VLOOKUP(A2,新房电话!C:L,8,0))"
.Value = .Value
End With
'匹配电话未接通
With Range(Cells(2, 4), Cells(mk, 4))
.Formula = "=IF(ISERROR(VLOOKUP(A2,新房电话!C:L,9,0)),0,VLOOKUP(A2,新房电话!C:L,9,0))"
.Value = .Value
End With
'匹配电话接通率
With Range(Cells(2, 5), Cells(mk, 5))
.Formula = "=IF(ISERROR(VLOOKUP(A2,新房电话!C:L,10,0)),""无"",VLOOKUP(A2,新房电话!C:L,10,0))"
.Value = .Value
.NumberFormat = "0%"
End With
'匹配直聊量
With Range(Cells(2, 6), Cells(mk, 6))
.Formula = "=IF(ISERROR(VLOOKUP(A2,新房直聊!D:J,4,0)),0,VLOOKUP(A2,新房直聊!D:J,4,0))"
.Value = .Value
End With
'匹配直聊有回复
With Range(Cells(2, 7), Cells(mk, 7))
.Formula = "=IF(ISERROR(VLOOKUP(A2,新房直聊!D:J,5,0)),0,VLOOKUP(A2,新房直聊!D:J,5,0))"
.Value = .Value
End With
'匹配直聊无回复
With Range(Cells(2, 8), Cells(mk, 8))
.Formula = "=IF(ISERROR(VLOOKUP(A2,新房直聊!D:J,6,0)),0,VLOOKUP(A2,新房直聊!D:J,6,0))"
.Value = .Value
End With
'匹配直聊回复率
With Range(Cells(2, 9), Cells(mk, 9))
.Formula = "=IF(ISERROR(VLOOKUP(A2,新房直聊!D:J,7,0)),""无"",VLOOKUP(A2,新房直聊!D:J,7,0))"
.Value = .Value
.NumberFormat = "0%"
End With
Columns(1).Insert
Cells(1, 1) = "日期"
Range(Cells(2, 1), Cells(mk, 1)) = wtdate
'复制新房电话直聊汇总数据到新房数据表的汇总表
Range(Cells(2, 1), Cells(mk, 10)).Copy Destination:=Workbooks("新房每日来电&每月成交情况汇总-updating.xlsx").Sheets("电话直聊每日接通情况").Cells(mmn, 3)
End If
'关闭并保存暂存文档
ActiveWorkbook.Close savechanges:=True
'关闭并保存新房数据汇总文档
If Workbooks.Count >= 2 Then
Workbooks("新房每日来电&每月成交情况汇总-updating.xlsx").Close savechanges:=True
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
类似资料：