整月半月0搜索推广流量数据

Option Explicit

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

'Call wangqu
Call businessshop
Call shangpu

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



'*********************王斌华瞿玲-热门楼盘词数据**************************
Sub wangqu()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'打开百度统计导出的搜索推广数据表
Dim wqstr As String
wqstr = Dir("d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\关键词*.csv", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\" & wqstr

'删除表里无用数据
Dim i As Byte
Rows("1:" & Columns(1).Find("第一部分", lookat:=xlPart).Row).Delete
Columns(1).Delete
Rows(2).Delete
Rows("10002:100000").Delete

'另存为xlsx格式文档
If Day(Date) > 15 And Day(Date) < 28 Then
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\" & Month(Date) & ".1-" & Month(Date) & ".15王斌华瞿玲-热门楼盘词数据.xlsx", FileFormat:=xlWorkbookDefault
ElseIf Day(Date) > 1 And Day(Date) < 15 Then
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\" & (Month(Date) - 1) & ".16-" & (Month(Date) - 1) & "." & Day(Application.WorksheetFunction.EoMonth(Date, -1)) & "王斌华瞿玲-热门楼盘词数据.xlsx", FileFormat:=xlWorkbookDefault
End If

'新建两张表放瞿玲、王斌华结果数据
Worksheets.Add after:=Sheets(Sheets.Count), Count:=4
Sheets(2).Name = "瞿玲区域二手房热搜楼盘"
Sheets(3).Name = "瞿玲区域租房热搜楼盘"
Sheets(4).Name = "王斌华区域二手房热搜楼盘"
Sheets(5).Name = "王斌华区域租房热搜楼盘"

'制表头
'瞿玲区域
'二手房数据表头
Sheets("瞿玲区域二手房热搜楼盘").Activate
Cells(1, 1) = "二手房楼盘排名"

'租房数据表头
Sheets("瞿玲区域租房热搜楼盘").Activate
Cells(1, 1) = "租房楼盘排名"

'王斌华区域
'二手房数据表头
Sheets("王斌华区域二手房热搜楼盘").Activate
Cells(1, 1) = "二手房楼盘排名"

Sheets("王斌华区域租房热搜楼盘").Activate
'租房数据表头
Cells(1, 1) = "租房楼盘排名"

'激活原表
Sheets(1).Activate

'浏览量降序排列
ActiveSheet.UsedRange.Sort key1:=Range("d1"), order1:=xlDescending, Header:=xlYes, Orientation:=xlTopToBottom

'将关键词列插入到浏览量列左边
Columns(Rows("1").Find("关键词", lookat:=xlWhole).Column).Cut
Columns(Rows("1").Find("浏览量(PV)", lookat:=xlWhole).Column).Insert shift:=xlToRight

'将停留时长转换成s
Cells(1, 6).Value = "平均访问时长(s)"
With Range(Cells(2, 6), Cells(Cells(1, 1).End(xlDown).Row, 6))
    .Formula = "=timevalue(e2)"
    .NumberFormat = "[s]"
    .Value = .Value
End With
Columns(5).Delete


'筛选出瞿玲二手房pc端数据并粘贴至结果表
ActiveSheet.UsedRange.AutoFilter field:=2, Criteria1:="=*售*"
ActiveSheet.UsedRange.AutoFilter field:=1, Criteria1:="=*瞿玲*", Operator:=xlAnd, Criteria2:="<>*移动端*"
Columns("c:e").Copy Destination:=Sheets("瞿玲区域二手房热搜楼盘").Range("b1")
'筛选出瞿玲租房PC端数据并粘贴至结果表
ActiveSheet.UsedRange.AutoFilter field:=2, Criteria1:="=*租*"
Columns("c:e").Copy Destination:=Sheets("瞿玲区域租房热搜楼盘").Range("b1")
'筛选出王斌华租房PC端数据并粘贴至结果表
ActiveSheet.UsedRange.AutoFilter field:=1, Criteria1:="=*王斌华*", Operator:=xlAnd, Criteria2:="<>*移动端*"
Columns("c:e").Copy Destination:=Sheets("王斌华区域租房热搜楼盘").Range("b1")
'筛选出王斌华租房wap端数据并粘贴至结果表
ActiveSheet.UsedRange.AutoFilter field:=1, Criteria1:="=*王斌华*", Operator:=xlAnd, Criteria2:="=*移动端*"
Columns("c:e").Copy Destination:=Sheets("王斌华区域租房热搜楼盘").Range("e1")
'筛选出王斌华二手房wap端数据并粘贴至结果表
ActiveSheet.UsedRange.AutoFilter field:=2, Criteria1:="=*售*"
Columns("c:e").Copy Destination:=Sheets("王斌华区域二手房热搜楼盘").Range("e1")
'筛选出王斌华二手房pc端数据并粘贴至结果表
ActiveSheet.UsedRange.AutoFilter field:=1, Criteria1:="=*王斌华*", Operator:=xlAnd, Criteria2:="<>*移动端*"
Columns("c:e").Copy Destination:=Sheets("王斌华区域二手房热搜楼盘").Range("b1")
'筛选出瞿玲二手房wap端数据并粘贴至结果表
ActiveSheet.UsedRange.AutoFilter field:=1, Criteria1:="=*瞿玲*", Operator:=xlAnd, Criteria2:="=*移动端*"
Columns("c:e").Copy Destination:=Sheets("瞿玲区域二手房热搜楼盘").Range("e1")
'筛选出瞿玲租房wap端数据并粘贴至结果表
ActiveSheet.UsedRange.AutoFilter field:=2, Criteria1:="=*租*"
ActiveSheet.UsedRange.AutoFilter field:=1, Criteria1:="=*瞿玲*", Operator:=xlAnd, Criteria2:="=*移动端*"
Columns("c:e").Copy Destination:=Sheets("瞿玲区域租房热搜楼盘").Range("e1")

'删除原表
Sheets(1).Delete

'完善各结果表
For i = 1 To 4
    Sheets(i).Activate
    
With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
End With
ActiveWindow.FreezePanes = True
    
    Cells(1, 2).Value = "PC楼盘名称"
    Cells(1, 5).Value = "WAP楼盘名称"
    
    Range("a2:a21") = Application.WorksheetFunction.Transpose(Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20))
    
    Rows("22:100000").Delete
    
    Range("a1:g1").Font.Bold = True
    
    Columns("a:g").AutoFit
    
    With Cells(1, 1).CurrentRegion
        .HorizontalAlignment = xlCenter '水平居中
        .VerticalAlignment = xlCenter '垂直居中
    End With
    Cells(1, 1).Select
Next


'保存文档
ActiveWorkbook.Close savechanges:=True


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
























'*********************工商铺热门楼盘词数据-写字楼**************************

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

'打开百度统计导出的搜索推广数据表
Dim wqstr As String
wqstr = Dir("d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\关键词*.csv", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\" & wqstr

'删除表里无用数据
Dim i As Byte
Rows("1:" & Columns(1).Find("第一部分", lookat:=xlPart).Row).Delete
Columns(1).Delete
Rows(2).Delete
Rows("10002:100000").Delete

'另存为xlsx格式文档

If Day(Date) > 15 And Day(Date) < 28 Then
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\" & Month(Date) & ".1-" & Month(Date) & ".15工商铺-热门楼盘词数据.xlsx", FileFormat:=xlWorkbookDefault
ElseIf Day(Date) > 1 And Day(Date) < 15 Then
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\" & (Month(Date) - 1) & ".16-" & (Month(Date) - 1) & "." & Day(Application.WorksheetFunction.EoMonth(Date, -1)) & "工商铺-热门楼盘词数据.xlsx", FileFormat:=xlWorkbookDefault
End If

'新建工商铺热搜楼盘结果数据
Worksheets.Add after:=Sheets(Sheets.Count)
Sheets(2).Name = "工商铺热搜楼盘"


'制表头
Sheets("工商铺热搜楼盘").Activate
Cells(1, 1) = "楼盘排名"

'激活原表
Sheets(1).Activate

'浏览量降序排列
ActiveSheet.UsedRange.Sort key1:=Range("d1"), order1:=xlDescending, Header:=xlYes, Orientation:=xlTopToBottom

'将关键词列插入到浏览量列左边
Columns(Rows("1").Find("关键词", lookat:=xlWhole).Column).Cut
Columns(Rows("1").Find("浏览量(PV)", lookat:=xlWhole).Column).Insert shift:=xlToRight

'将停留时长转换成s
Cells(1, 6).Value = "平均访问时长(s)"
With Range(Cells(2, 6), Cells(Cells(1, 1).End(xlDown).Row, 6))
    .Formula = "=timevalue(e2)"
    .NumberFormat = "[s]"
    .Value = .Value
End With
Columns(5).Delete


'筛选出工商铺数据并粘贴至结果表
ActiveSheet.UsedRange.AutoFilter field:=1, Criteria1:="=*工商铺*"
ActiveSheet.UsedRange.AutoFilter field:=2, Criteria1:="=*写字楼楼盘*"
Columns("c:e").Copy Destination:=Sheets("工商铺热搜楼盘").Range("b1")

'删除原表
Sheets(1).Delete

'合并楼盘数据,完善结果表
Cells(1, 2) = "楼盘名称"

Cells(1, 5) = "总访问时长"
With Range("e2:e" & Range("b65565").End(xlUp).Row)
    .Formula = "=c2*d2"
    .NumberFormat = "[s]"
    .Value = .Value
End With

Cells(1, 6) = "总访问时长(合并)"
With Range("f2:f" & Range("b65565").End(xlUp).Row)
    .Formula = "=SUMif(B:B,B2,E:E)"
    .Value = .Value
End With

Cells(1, 7) = "浏览量"
With Range("g2:g" & Range("b65565").End(xlUp).Row)
    .Formula = "=sumif(B:B,b2,C:C)"
    .Value = .Value
End With

Cells(1, 8) = "平均访问时长(秒)"
With Range("h2:h" & Range("b65565").End(xlUp).Row)
    .Formula = "=g2/f2"
    .Value = .Value
    .NumberFormat = "0"
End With

Union(Columns(1), Columns(2), Columns(7), Columns(8)).Copy Destination:=Range("j1")
Columns("a:i").Delete

ActiveSheet.UsedRange.Sort key1:=Range("c1"), order1:=xlDescending, Header:=xlYes, Orientation:=xlTopToBottom

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

'填入楼盘排名
Dim mmk As Range
For Each mmk In Range("a2:a" & Range("b65687").End(xlUp).Row)
mmk = mmk.Row - 1
Next


'调整格式排版
Application.Goto Range("a1")
With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
    .FreezePanes = True
End With

    
Range("a1:d1").Font.Bold = True
    
Columns("a:d").AutoFit
    
With Cells(1, 1).CurrentRegion
    .HorizontalAlignment = xlCenter '水平居中
    .VerticalAlignment = xlCenter '垂直居中
End With
    Cells(1, 1).Select



'保存文档
ActiveWorkbook.Close savechanges:=True

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

















'*********************工商铺热门楼盘词数据-商铺**************************

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

'打开百度统计导出的搜索推广数据表
Dim wqstr As String
wqstr = Dir("d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\关键词*.csv", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\" & wqstr

'删除表里无用数据
Dim i As Byte
Rows("1:" & Columns(1).Find("第一部分", lookat:=xlPart).Row).Delete
Columns(1).Delete
Rows(2).Delete
Rows("10002:100000").Delete

'另存为xlsx格式文档

If Day(Date) > 15 And Day(Date) < 28 Then
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\" & Month(Date) & ".1-" & Month(Date) & ".15工商铺-商铺热搜词数据.xlsx", FileFormat:=xlWorkbookDefault
ElseIf Day(Date) > 1 And Day(Date) < 15 Then
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\整月半月搜索推广流量数据\" & (Month(Date) - 1) & ".16-" & (Month(Date) - 1) & "." & Day(Application.WorksheetFunction.EoMonth(Date, -1)) & "工商铺-商铺热搜词数据.xlsx", FileFormat:=xlWorkbookDefault
End If

'新建商铺热搜楼盘结果数据
Worksheets.Add after:=Sheets(Sheets.Count)
Sheets(2).Name = "商铺热搜楼盘"


'制表头
Sheets("商铺热搜楼盘").Activate
Cells(1, 1) = "楼盘排名"

'激活原表
Sheets(1).Activate

'浏览量降序排列
ActiveSheet.UsedRange.Sort key1:=Range("d1"), order1:=xlDescending, Header:=xlYes, Orientation:=xlTopToBottom

'将关键词列插入到浏览量列左边
Columns(Rows("1").Find("关键词", lookat:=xlWhole).Column).Cut
Columns(Rows("1").Find("浏览量(PV)", lookat:=xlWhole).Column).Insert shift:=xlToRight

'将停留时长转换成s
Cells(1, 6).Value = "平均访问时长(s)"
With Range(Cells(2, 6), Cells(Cells(1, 1).End(xlDown).Row, 6))
    .Formula = "=timevalue(e2)"
    .NumberFormat = "[s]"
    .Value = .Value
End With
Columns(5).Delete


'筛选出工商铺数据并粘贴至结果表
ActiveSheet.UsedRange.AutoFilter field:=1, Criteria1:="=*工商铺*"
ActiveSheet.UsedRange.AutoFilter field:=2, Criteria1:="=*商铺*"
Columns("c:e").Copy Destination:=Sheets("商铺热搜楼盘").Range("b1")

'删除原表
Sheets(1).Delete

'合并楼盘数据,完善结果表
Cells(1, 2) = "热搜词"

Cells(1, 5) = "总访问时长"
With Range("e2:e" & Range("b65565").End(xlUp).Row)
    .Formula = "=c2*d2"
    .NumberFormat = "[s]"
    .Value = .Value
End With

Cells(1, 6) = "总访问时长(合并)"
With Range("f2:f" & Range("b65565").End(xlUp).Row)
    .Formula = "=SUMif(B:B,B2,E:E)"
    .Value = .Value
End With

Cells(1, 7) = "浏览量"
With Range("g2:g" & Range("b65565").End(xlUp).Row)
    .Formula = "=sumif(B:B,b2,C:C)"
    .Value = .Value
End With

Cells(1, 8) = "平均访问时长(秒)"
With Range("h2:h" & Range("b65565").End(xlUp).Row)
    .Formula = "=g2/f2"
    .Value = .Value
    .NumberFormat = "0"
End With

Union(Columns(1), Columns(2), Columns(7), Columns(8)).Copy Destination:=Range("j1")
Columns("a:i").Delete

ActiveSheet.UsedRange.Sort key1:=Range("c1"), order1:=xlDescending, Header:=xlYes, Orientation:=xlTopToBottom

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

'填入楼盘排名
Dim mmk As Range
For Each mmk In Range("a2:a" & Range("b65687").End(xlUp).Row)
mmk = mmk.Row - 1
Next


'调整格式排版
Application.Goto Range("a1")
With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
    .FreezePanes = True
End With

    
Range("a1:d1").Font.Bold = True
    
Columns("a:d").AutoFit
    
With Cells(1, 1).CurrentRegion
    .HorizontalAlignment = xlCenter '水平居中
    .VerticalAlignment = xlCenter '垂直居中
End With
    Cells(1, 1).Select



'保存文档
ActiveWorkbook.Close savechanges:=True

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub