上月zy网小区访问及来电情况

Option Explicit

'……………………………………………………………………上月中原网小区访问及来电情况…………………………………………………………………………………………………………………

Sub zyestate()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Call zyestate1
Call zyestate2
Call zyestate3
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub




''''''''''''''''''''''''''''''''''''''''''''''''''第1步:把所需访问数据提取到访问表''''''''''''''''''''''''''''''''''''''''''''''''''
Sub zyestate1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False


'新建sheet[上月访问]
Workbooks.Add.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\上月中原网小区访问及来电" & "\" & Year(Now()) & "年" & Month(Now()) - 1 & "月访问.xlsx"
Dim fwwbk As Workbook
Set fwwbk = ActiveWorkbook
Sheets.Add after:=Sheets(Sheets.Count), Count:=2
Sheets(2).Name = "提取房源"
Sheets(3).Name = "提取小区"



Application.Goto reference:=Sheets(1).Range("a1")
Sheets(1).Range("a1:c1") = Array("页面url", "访问次数", "访客数")

'将在百度统计导出的访问数据依次导入[上月访问sheet]
Dim str1 As String, k1 As Byte
For k1 = 1 To 9
str1 = Dir("d:\Users\zhanggl21\Desktop\6666\上月中原网小区访问及来电\" & k1 & "入口页面*.csv", vbNormal)
If Len(str1) > 0 Then
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月中原网小区访问及来电\" & str1
Range("b3:d" & (Cells(1, 4).End(xlDown).Row - 1)).Copy Destination:=fwwbk.Sheets(1).Cells(100000, 1).End(xlUp).Offset(1, 0)
ActiveWorkbook.Close savechanges:=False
End If
Next



'打开[数据匹配与高级筛选]sheet
Workbooks.Open Filename:="E:\lele月工作记录\数据匹配与高级筛选201712updated.xlsx"


'将链接为房源同时访客数>0的记录复制到[提取房源]sheet
Application.Goto reference:=fwwbk.Sheets(1).Range("a1")
ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterCopy, _
criteriarange:=Workbooks("数据匹配与高级筛选201712updated.xlsx").Sheets("数据高级筛选20180104").Range("b109:c110"), _
copytorange:=fwwbk.Sheets("提取房源").Range("a1"), unique:=False

'将链接为房源同时访客数>0的记录复制到[提取小区]sheet
Application.Goto reference:=fwwbk.Sheets(1).Range("a1")
ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterCopy, _
criteriarange:=Workbooks("数据匹配与高级筛选201712updated.xlsx").Sheets("数据高级筛选20180104").Range("b116:c117"), _
copytorange:=fwwbk.Sheets("提取小区").Range("a1"), unique:=False

'关掉筛选文档
Workbooks("数据匹配与高级筛选201712updated.xlsx").Close savechanges:=False

'删除访问的第一张表
Sheets(1).Delete

ActiveWorkbook.Close savechanges:=True

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub




''''''''''''''''''''''''''''''''''''''''''''''''''第2步:把所需访问数据提取到访问表''''''''''''''''''''''''''''''''''''''''''''''''''

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


Dim str2 As String, fwwbk As Workbook

str2 = VBA.Dir("d:\Users\zhanggl21\Desktop\6666\上月中原网小区访问及来电\*月访问.xlsx", vbNormal)

Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月中原网小区访问及来电\" & str2
Set fwwbk = ActiveWorkbook

'添加“房源编号”、"租售"、"端口"、"小区编号"、"合并"五列
Sheets("提取房源").Range("d1:g1") = Array("房源编号", "租售", "端口", "小区编号")
'提取房源编号
Dim k2 As Long
k2 = Cells(1, 1).End(xlDown).Row

With Range("d2:d" & k2)
    .Formula = "=upper(MID(A2,SEARCH(""fang/"",A2)+5,14))"
    .Value = .Value
End With

'匹配租售
With Range("e2:e" & k2)
    .Formula = "=IF((SEARCH(""fang"",a2)>=30)*1,""二手房"",""租房"")"
    .Value = .Value
End With


'匹配端口
With Range("f2:f" & k2)
    .Formula = "=IF(ISNUMBER(SEARCH(""/m/"",a2)),""WAP"",""PC"")"
    .Value = .Value
End With

'匹配小区编号
'打开房源与小区匹配表
Dim str3 As String
str3 = Dir("E:\lele月工作记录\中原网区域板块及小区房源对应表*.xlsx", vbNormal)

Workbooks.Open Filename:="E:\lele月工作记录\" & str3

Application.Goto fwwbk.Sheets("提取房源").Range("a1")

'同时删除未匹配的记录
With Range("g2:g" & k2)
    .Formula = "=VLOOKUP(D2,[中原网区域板块及小区房源对应表20180809.xlsx]Sheet0!$A:$B,2,0)"
    .Value = .Value
    .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End With

'调整列位置
Columns("b:c").Cut
Columns("e:f").Insert shift:=xlToRight



'在小区表匹配出租售、端口、小区编号
Application.Goto fwwbk.Sheets("提取小区").Range("a1")

Range("d1:f1") = Array("租售", "端口", "小区编号")

Dim k3 As Long
k3 = Cells(1, 1).End(xlDown).Row
'匹配租售
With Range("d2:d" & k3)
    .Formula = "=IF(ISNUMBER(SEARCH(""/zf"",A2)),""租房"",""二手房"")"
    .Value = .Value
End With

'匹配端口
With Range("e2:e" & k3)
    .Formula = "=IF(ISNUMBER(SEARCH(""com/m/"",A2)),""WAP"",""PC"")"
    .Value = .Value
End With

'匹配小区编号
With Range("f2:f" & k3)
    .Formula = "=upper(MID(a2,SEARCH(""-"",a2)+1,10))"
    .Value = .Value
End With

'删除小区表里的首列[页面url]
Columns(1).Delete


'将房源表里的数据复制粘贴到小区表
Application.Goto fwwbk.Sheets("提取房源").Range("a1")
    
Range("c2:g" & Cells(1, 1).End(xlDown).Row).Copy Destination:=Sheets("提取小区").Cells(k3 + 1, 1)


'对同小区同端口同租售，汇总访问次数和访客数
Application.Goto fwwbk.Sheets("提取小区").Range("a1")
Range("f1:g1") = Array("访问次数汇总", "访客数汇总")

Dim k4 As Long
k4 = Cells(1, 1).End(xlDown).Row

'汇总访问次数

With Range("f2:f" & k4)
    .Formula = "=SUMIFS(A:A,C:C,C2,D:D,D2,E:E,E2)"
    .Value = .Value
End With

'汇总访客数
With Range("g2:g" & k4)
    .Formula = "=SUMIFS(B:B,C:C,C2,D:D,D2,E:E,E2)"
    .Value = .Value
End With


'去重
Columns("a:b").Delete
Columns("a:e").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes


'匹配小区的名称、区域、板块
Dim k5 As Long
k5 = Cells(1, 1).End(xlDown).Row

Range("f1:h1") = Array("小区名称", "区域", "板块")

'匹配小区名称
With Range("f2:f" & k5)
    .Formula = "=VLOOKUP($C2,[中原网区域板块及小区房源对应表20180809.xlsx]Sheet0!$B:$G,2,0)"
    .Value = .Value
End With

'匹配区域
With Range("g2:g" & k5)
    .Formula = "=VLOOKUP($C2,[中原网区域板块及小区房源对应表20180809.xlsx]Sheet0!$B:$G,5,0)"
    .Value = .Value
End With

'匹配板块
With Range("h2:h" & k5)
    .Formula = "=VLOOKUP($C2,[中原网区域板块及小区房源对应表20180809.xlsx]Sheet0!$B:$G,6,0)"
    .Value = .Value
    .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End With


'关闭并保存访问表
fwwbk.Close savechanges:=True

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub






''''''''''''''''''''''''''''''''''''''''''''''''''第3步:结果表''''''''''''''''''''''''''''''''''''''''''''''''''

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

'新建结果表
Workbooks.Add.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\上月中原网小区访问及来电\" & Year(Now()) & "年" & Month(Now()) - 1 & "月中原网小区访问&来电Report", FileFormat:=xlWorkbookDefault

Dim jgwbk As Workbook
Set jgwbk = ActiveWorkbook

Sheets.Add Count:=1

Sheets(1).Name = Month(Now()) - 1 & "月访问"
Sheets(2).Name = Month(Now()) - 1 & "月来电"

Dim wsht1 As Worksheet
Dim wsht2 As Worksheet
Set wsht1 = Sheets(Month(Now()) - 1 & "月访问")
Set wsht2 = Sheets(Month(Now()) - 1 & "月来电")

'打开上月的电话总表
Dim str4 As String, callwbk As Workbook
str4 = Dir("d:\Users\zhanggl21\Desktop\6666\上月中原网小区访问及来电\*400来电.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月中原网小区访问及来电\" & str4
Set callwbk = ActiveWorkbook

'将所需列复制到结果表的来电sheet
ActiveSheet.UsedRange.AutoFilter field:=7, Criteria1:="=售", _
        Operator:=xlOr, Criteria2:="=租"
    ActiveSheet.UsedRange.AutoFilter field:=11, Criteria1:=Array( _
        "官网PC渠道", "官网Wap", "官网Wap渠道", "上海", "中原找房APP"), Operator:=xlFilterValues

Union(Columns(1), Columns(3), Columns(6), Columns(7), Columns(11)).Copy

wsht2.Activate
Range("a1").PasteSpecial xlPasteValues

callwbk.Close savechanges:=False

'在结果文档的来电表里匹配区域    片区    端口
Application.Goto wsht2.Range("a1")

Range("f1:h1") = Array("区域", "片区", "端口")

Dim k6 As Long
k6 = Cells(1, 1).End(xlDown).Row

'匹配区域
With Range("f2:f" & k6)
    .Formula = "=VLOOKUP(C2,[中原网区域板块及小区房源对应表20180809.xlsx]Sheet0!$C:$G,4,0)"
    .Value = .Value
End With

'匹配端口
With Range("h2:h" & k6)
    .Formula = "=IF(or(e2=""官网Wap"",e2=""官网Wap渠道""),""WAP"",if(e2=""中原找房APP"",""APP"",""PC""))"
    .Value = .Value
End With

'匹配片区
With Range("g2:g" & k6)
    .Formula = "=VLOOKUP($C2,[中原网区域板块及小区房源对应表20180809.xlsx]Sheet0!$C:$G,5,0)"
    .Value = .Value
    .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End With

'关闭房源与小区匹配表
Workbooks("中原网区域板块及小区房源对应表20180809.xlsx").Close savechanges:=False

'将访问数据复制粘贴到结果文档的访问表
Dim str5 As String, fwbk As Workbook
str5 = Dir("d:\Users\zhanggl21\Desktop\6666\上月中原网小区访问及来电\*月访问.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月中原网小区访问及来电\" & str5
Set fwbk = ActiveWorkbook

Sheets("提取小区").UsedRange.Copy

wsht1.Activate
Range("a1").PasteSpecial xlPasteValues
fwbk.Close savechanges:=False

jgwbk.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub