Option Explicit
Dim rwbk As Workbook
Dim rsht As Worksheet
'…………………………………………………………………………………各区董楼盘点击及电话直聊情况……………………………………………………………………………………………………………………………………
Sub qdallestate()
Application.ScreenUpdating = False
Application.DisplayAlerts = FalseCall qdallestate1Call qdallestate2Call qdallestate3Call qdallestate4Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub'………………………………1.新建结果文档并处理导出的关键词报表………………………………………………………………
Sub qdallestate1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False'打开结果文档
Dim str1 As String
str1 = Dir("d:\Users\zhanggl21\Desktop\6666\上月各区董楼盘点击及电话直聊情况(所有楼盘)\*各区董楼盘点击及电话直聊情况*.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月各区董楼盘点击及电话直聊情况(所有楼盘)\" & str1
ActiveSheet.Rows("2:50000").ClearContents
ActiveSheet.Name = Year(Now()) & "年" & Month(Now()) - 1 & "月结果表"
'定义结果表
Set rsht = ActiveSheet'定义结果文档
Set rwbk = ActiveWorkbook'新建1张表
Sheets.Add after:=Sheets(Sheets.Count), Count:=2
Sheets(2).Name = "关键词"
Sheets(3).Name = "暂存"'打开关键词报表
Dim str2 As String
str2 = Dir("d:\Users\zhanggl21\Desktop\6666\上月各区董楼盘点击及电话直聊情况(所有楼盘)\*关键词*", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月各区董楼盘点击及电话直聊情况(所有楼盘)\" & str2
'删除无效行与列
Rows("1:3").Delete
Columns("a").Delete
Rows("2").Delete
Rows(Cells(1, 1).End(xlDown).Row & ":100000").Delete
'筛选所需数据
ActiveSheet.UsedRange.AutoFilter field:=2, Criteria1:="*战区*", Operator:=xlFilterValues
Range("a1:h100000").SpecialCells(xlCellTypeVisible).Copy Destination:=rwbk.Sheets("关键词").Range("a1")
'关闭关键词报表文档
ActiveWorkbook.Close savechanges:=False'跳转到结果文档的关键词表
Application.Goto rwbk.Sheets("关键词").Range("a1")
'提取区董姓名(并删除匹配不到的记录)
Columns("d").Insert
Range("d1") = "区董"
With Range("d2:d" & Cells(1, 1).End(xlDown).Row).Formula = "=MID(B2,SEARCH(""("",B2)+1,SEARCH(""-"",B2,5)-1-SEARCH(""("",B2))".Value = .Value.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End With'删除无用的列
Range("b:c").Delete'新增3列
Dim ac As Byte
ac = Cells(1, 1).End(xlToRight).Column
Cells(1, ac + 1).Resize(1, 9) = Array("平均访问时长s", "跳出次数", "访问时长", "总浏览量", "总访问次数", "总跳出次数", "总访问时长", "平均访问时长(终)", "跳出率(终)")'将平均访问时长转化为s
Dim rcl As Long
rcl = Cells(1, 1).End(xlDown).Row
With Range(Cells(2, ac + 1), Cells(rcl, ac + 1)).Formula = "=timevalue(rc[-1])".Value = .Value.NumberFormat = "[s]"
End With
'删除原来的平均访问时长字段列
Columns(ac).Delete'填充跳出次数
With Range(Cells(2, ac + 1), Cells(rcl, ac + 1)).Formula = "=rc[-2]*rc[-3]".Value = .Value
End With'填充访问时长
With Range(Cells(2, ac + 2), Cells(rcl, ac + 2)).Formula = "=rc[-2]*rc[-4]".Value = .Value.NumberFormat = "[s]"
End With'填充总浏览量
With Range(Cells(2, ac + 3), Cells(rcl, ac + 3)).Formula = "=SUMIFS(C:C,B:B,B2,A:A,A2)".Value = .Value.NumberFormat = "general"
End With'填充总访问次数
With Range(Cells(2, ac + 4), Cells(rcl, ac + 4)).Formula = "=SUMIFS(d:d,B:B,B2,A:A,A2)".Value = .Value.NumberFormat = "general"
End With'填充总跳出次数
With Range(Cells(2, ac + 5), Cells(rcl, ac + 5)).Formula = "=SUMIFS(g:g,B:B,B2,A:A,A2)".Value = .Value.NumberFormat = "general"
End With'填充总访问时长
With Range(Cells(2, ac + 6), Cells(rcl, ac + 6)).Formula = "=SUMIFS(h:h,B:B,B2,A:A,A2)".Value = .Value.NumberFormat = "[s]"
End With'填充平均访问时长
With Range(Cells(2, ac + 7), Cells(rcl, ac + 7)).Formula = "=rc[-1]/rc[-3]".Value = .Value.NumberFormat = "[s]"
End With'填充跳出率
With Range(Cells(2, ac + 8), Cells(rcl, ac + 8)).Formula = "=rc[-3]/rc[-4]".Value = .Value.NumberFormat = "0.00%"
End With'将所需结果单独复制出来
Application.Union(Columns("a:b"), Columns(ac + 3), Columns(ac + 7), Columns(ac + 8)).Copy Destination:=[s1]'将结果去重
Columns("s").Resize(, 5).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes'将列名“关键词”修改为“楼盘名称”,将列名“总浏览量”修改为“浏览量”
With Range("s1").Resize(, 5).Find(what:="关键词", lookat:=xlPart) = "楼盘名称".Find("总浏览量", lookat:=xlPart) = "浏览量"
'调整各列位置Columns(.Find(what:="区董", lookat:=xlPart).Column).CutColumns("s").Insert shift:=xlToRightColumns(.Find(what:="跳出率(终)", lookat:=xlPart).Column).CutColumns("v").Insert shift:=xlToRight.Find(what:="跳出率(终)", lookat:=xlPart) = "跳出率".Find("平均访问时长(终)", lookat:=xlPart) = "平均访问时长"
End With'复制到结果表
Range(Range("s2"), Range("w" & Range("s1").End(xlDown).Row)).Copy
rsht.Activate
[b2].PasteSpecial Paste:=xlPasteValues'将楼盘名称复制到暂存表的M列
Columns("c").Copy Destination:=Sheets("暂存").Range("g1")End Sub'…………………………………………2.将在关键词报表中未出现的楼盘复制到结果表………………………………………………………………………………Sub qdallestate2()
Application.ScreenUpdating = False
Application.DisplayAlerts = False'打开上周的房源明细表
Dim str2 As String
str2 = Dir("d:\Users\zhanggl21\Desktop\6666\上月各区董楼盘点击及电话直聊情况(所有楼盘)\*中原网房源明细*.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月各区董楼盘点击及电话直聊情况(所有楼盘)\" & str2'将区董和楼盘名称两列复制到暂存表
Dim ik As Byte, jk As Byte
ik = Rows("1").Find("区董", lookat:=xlPart).Column
jk = Rows("1").Find("楼盘名称", lookat:=xlPart).Column
Union(Columns(ik), Columns(jk)).CopyApplication.Goto rwbk.Sheets("暂存").Range("a1")
Range("a1").PasteSpecial Paste:=xlPasteValues'关掉房源明细表
Workbooks(str2).Close savechanges:=False'将暂存表里的楼盘名称分列处理
With Columns(2).TextToColumns DataType:=xlDelimited, other:=True, otherchar:="(".TextToColumns DataType:=xlDelimited, other:=True, otherchar:="（".TextToColumns DataType:=xlDelimited, other:=True, otherchar:="-"
End With'删除多余列
'Columns("c:h").Delete'区董与楼盘去重
Columns("a:b").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes'筛选在结果表里未出现的楼盘
Range("c1") = "筛选楼盘"
With Range("c2:c" & Cells(1, 1).End(xlDown).Row).Formula = "=IF(ISERROR(VLOOKUP(B2,g:g,1,0)),1,0)".Value = .Value
End With'筛选出所需楼盘和区董
Range("a:c").AutoFilter field:=3, Criteria1:="1", Operator:=xlFilterValues
Range("a2:b50000").SpecialCells(xlCellTypeVisible).Copy'将所需楼盘和区董复制到结果表
rsht.Activate
Cells(Cells(1, 2).End(xlDown).Row, 2).Offset(1, 0).PasteSpecial Paste:=xlPasteValues'填充浏览量列
Columns("d").SpecialCells(xlCellTypeBlanks).Select
Selection.Value = 0'填充跳出率列
Columns("e").SpecialCells(xlCellTypeBlanks).Select
Selection.Value = "无"'填充平均访问时长(s)列
Columns("f").SpecialCells(xlCellTypeBlanks).Select
Selection.Value = "无"End Sub'…………………………………………3.匹配出所有楼盘的电话与直聊量………………………………………………………………………………Sub qdallestate3()
Application.ScreenUpdating = False
Application.DisplayAlerts = False'打开上月的各楼盘电话及直聊量
Dim str3 As String
str3 = Dir("d:\Users\zhanggl21\Desktop\6666\上月各区董楼盘点击及电话直聊情况(所有楼盘)\*各区董下属楼盘直聊电话*.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月各区董楼盘点击及电话直聊情况(所有楼盘)\" & str3Application.Goto Sheets("R电话").Range("a1")
Range("k:l").Copy Destination:=rsht.Range("l1")Application.Goto Sheets("R直聊").Range("a1")
Range("k:l").Copy Destination:=rsht.Range("p1")ActiveWorkbook.Close savechanges:=False'计算出各楼盘的直聊回复率
Dim str4 As String
str4 = Dir("d:\Users\zhanggl21\Desktop\6666\上月各区董楼盘点击及电话直聊情况(所有楼盘)\*直聊.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月各区董楼盘点击及电话直聊情况(所有楼盘)\" & str4'将所需数据复制到结果文档的[关键词]表
ActiveSheet.UsedRange.AutoFilter field:=17, Criteria1:="<>"
Dim aa As Byte
Dim bb As Byte
Dim cc As Byte
aa = Rows("1").Find("序号", lookat:=xlPart).Column
bb = Rows("1").Find("回复数", lookat:=xlPart).Column
cc = Rows("1").Find("小区", lookat:=xlPart).ColumnUnion(Columns(aa), Columns(bb), Columns(cc)).Copyrsht.Activate[t1].PasteSpecial xlPasteValues
Columns("t").Resize(, 3).RemoveDuplicates Columns:=Array(1, 2, 3)'关闭直聊表
Workbooks(str4).Close savechanges:=FalseDim mm As Integer
mm = [u1].End(xlDown).Row[w1] = "经纪人回复情况"
[x1] = "直聊回复率"With Range(Cells(2, 23), Cells(mm, 23)).Formula = "=IF(U2>0,1,0)".Value = .Value
End WithWith Range(Cells(2, 24), Cells(mm, 24)).Formula = "=SUMIF(V:V,V2,W:W)/COUNTIF(V:V,V2)".Value = .Value.NumberFormat = "0%"
End WithEnd Sub'…………………………………………4.匹配出所有楼盘的电话与直聊量与直聊回复率………………………………………………………………………………Sub qdallestate4()
Application.ScreenUpdating = False
Application.DisplayAlerts = False'匹配出各楼盘的来电量与直聊量与直聊回复率
Dim kk As Integer
kk = [c1].End(xlDown).Row'匹配电话量
With Range(Cells(2, 7), Cells(kk, 7)).Formula = "=VLOOKUP(C2,L:M,2,0)".Value = .Value
End With'匹配直聊量
With Range(Cells(2, 8), Cells(kk, 8)).Formula = "=VLOOKUP(C2,p:q,2,0)".Value = .Value
End With'匹配直聊回复率
With Range(Cells(2, 9), Cells(kk, 9)).Formula = "=VLOOKUP(C2,V:X,3,0)".Value = .Value
End With'来电量匹配不到的标记为０
Range("g:g").SpecialCells(xlCellTypeConstants, xlErrors) = 0'直聊量匹配不到的标记为０
Range("h:h").SpecialCells(xlCellTypeConstants, xlErrors) = 0'直聊回复率匹配不到的标记为"无"
Range("i:i").SpecialCells(xlCellTypeConstants, xlErrors) = "无"Columns("k:z").Delete'填入时间字段
Range(Cells(2, 1), Cells(kk, 1)) = Year(Now()) & "年" & Month(Now()) - 1 & "月"'把多余楼盘删掉
Range("j1") = "筛选"
With Range(Cells(2, 10), Cells(kk, 10)).Formula = "=countif(c:c,c2)".Value = .Value
End With
ActiveSheet.UsedRange.AutoFilter field:=10, Criteria1:=">1"
Rows("2:20000").SpecialCells(xlCellTypeVisible).Delete
ActiveSheet.AutoFilterMode = FalseColumns("j").Delete'把直聊量为0且直聊回复率>0的记录删掉
ActiveSheet.UsedRange.AutoFilter field:=9, Criteria1:="无"
ActiveSheet.UsedRange.AutoFilter field:=8, Criteria1:=">0"
Rows("2:20000").SpecialCells(xlCellTypeVisible).Delete
ActiveSheet.AutoFilterMode = False'把区董为"-"的记录删掉
ActiveSheet.UsedRange.AutoFilter field:=2, Criteria1:="-"
Rows("2:20000").SpecialCells(xlCellTypeVisible).Delete
ActiveSheet.AutoFilterMode = False'格式调整
Range("a2:i2").Copy
Range("a2:i" & Cells(1, 1).End(xlDown).Row).PasteSpecial (xlPasteFormats)'按区董为主关键词、浏览量为次关键词、楼盘名称为次关键词升序排列
ActiveSheet.UsedRange.Sort key1:=Range("b1"), order1:=xlAscending, key2:=Range("d1"), order2:=xlDescending, Header:=xlYes, Orientation:=xlTopToBottom'删除后两个sheet
Sheets(Array(2, 3)).DeleteActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & Year(Now()) & "年" & Month(Now()) - 1 & "月各区董楼盘点击及电话直聊情况(所有楼盘)-新.xlsx"ActiveWorkbook.Close savechanges:=FalseEnd Sub