周0上周直聊委托约看400

Option Explicit

Sub caoluweekly()
Call caoluw电话
Call caoluw委托
Call caoluw直聊
Call caoluw约看
End Sub




'...............上周400电话...............
Sub caoluw电话()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

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

'打开电话原始表
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\CallLogs.xls"
'另存为电话结果表
If Now() - Range("b2") < 12 Then
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\" & Format(Now() - Weekday(Now(), 2) - 6, "yyyy.mm.dd") & "-" & Format(Now() - Weekday(Now(), 2), "yyyy.mm.dd") & "来电.xlsx", FileFormat:=xlWorkbookDefault
Else
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\" & Month(Date - 7) & "." & Day(Date - 7) & "-" & Month(Date - 1) & "." & Day(Date - 1) & "来电.xlsx", FileFormat:=xlWorkbookDefault
End If

'插入'日期'列
Dim i As Byte
i = Cells.Find("被叫时间", lookat:=xlWhole).Column
Columns(i + 1).Insert
Cells(1, i + 1).Value = "riqi"
With Range(Cells(2, i + 1), Cells(Range("a60000").End(xlUp).Row, i + 1))
    .Formula = "=int(rc[-1])"
    .NumberFormat = "yyyy/mm/dd"
    .Value = .Value
End With

'删除无效日期记录
ActiveSheet.UsedRange.AutoFilter field:=i + 1, Criteria1:="<2018"
Range("a2:x60000").EntireRow.Delete
ActiveSheet.AutoFilterMode = False

'删除包含屏蔽号码的记录
Dim k As Byte
k = Cells.Find("客户信息", lookat:=xlWhole).Column
Columns(k + 1).Insert
Cells(1, k + 1).Value = "清洗"
With Range(Cells(2, k + 1), Cells(Range("a60000").End(xlUp).Row, k + 1))
    .Formula = "=vlookup(k2,[数据匹配与高级筛选201712updated.xlsx]内部屏蔽号码20180104updated!$A$2:$A$60000,1,0)"
    .NumberFormat = "general"
'去除公式(保留值)
    .Value = .Value
End With
Workbooks("数据匹配与高级筛选201712updated.xlsx").Close savechanges:=False
ActiveSheet.UsedRange.AutoFilter field:=k + 1, Criteria1:=">0"
Range("a2:x60000").EntireRow.Delete
ActiveSheet.AutoFilterMode = False
Columns(k + 1).Delete

'删除包含215178的记录
ActiveSheet.UsedRange.AutoFilter field:=k, Criteria1:=">2151780000", Operator:=xlAnd, Criteria2:="<2151789999"
Range("a2:x60000").EntireRow.Delete
ActiveSheet.AutoFilterMode = False
Columns(k + 1).Delete


'将业务信息展开为3列
Dim m As Byte
m = Cells.Find("业务信息", lookat:=xlWhole).Column
Union(Columns(m + 1), Columns(m + 2), Columns(m + 3), Columns(m + 4)).Insert
Columns(m).TextToColumns DataType:=xlDelimited, Space:=True
Cells(1, m) = "业务员电话"
Cells(1, m + 1) = "业务员姓名"
Cells(1, m + 2) = "业务员工号"
Columns(m + 3).Delete
Columns(m + 3).Delete

'根据房源信息匹配出租售分类
Dim n As Byte
n = Cells.Find("房源信息", lookat:=xlWhole).Column
Columns(n + 1).Insert
Cells(1, n + 1).Value = "租售"
With Range(Cells(2, n + 1), Cells(Range("a60000").End(xlUp).Row, n + 1))
    .Formula = "=IF(RIGHT(F2,2)=""/月"",""租"",IF(and(RIGHT(F2,1)=""元"",len(f2)>4),""售"",IF(LEFT(F2,7)=""Newprop"",""新房-售"","""")))"
    .NumberFormat = "general"
'去除公式(保留值)
    .Value = .Value
End With

'将房源信息模糊处理
Union(Columns(n + 1), Columns(n + 2), Columns(n + 3), Columns(n + 4)).Insert
Columns(n).TextToColumns DataType:=xlDelimited, Space:=True
Columns(n).TextToColumns DataType:=xlDelimited, other:=True, otherchar:="("
Columns(n).TextToColumns DataType:=xlDelimited, other:=True, otherchar:="（"
Union(Columns(n + 1), Columns(n + 2), Columns(n + 3), Columns(n + 4)).Delete

'美化调整格式
'所有行高自适应
Rows("1:10000").EntireRow.AutoFit
'所有列宽自适应
Columns("a:t").EntireColumn.AutoFit
'首行美化
Range("a1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection
    .Interior.Color = RGB(0, 0, 0)
    .Font.Color = RGB(255, 255, 255)
End With
'首行重要标题醒目黄色处理
With Rows("1").Find("riqi", lookat:=xlWhole)
    .Interior.Color = RGB(255, 255, 0)
    .Font.Color = RGB(0, 0, 0)
End With
With Rows("1").Find("租售", lookat:=xlWhole)
    .Interior.Color = RGB(255, 255, 0)
    .Font.Color = RGB(0, 0, 0)
End With
Rows("1").Find("房源信息", lookat:=xlWhole) = "小区"
With Rows("1").Find("小区", lookat:=xlWhole)
    .Interior.Color = RGB(255, 255, 0)
    .Font.Color = RGB(0, 0, 0)
End With

'整表文字调整为微软雅黑并居中对齐
Cells.Select
With Selection
    .WrapText = False
    .Font.Name = "微软雅黑"
    .Font.Size = 10
    .VerticalAlignment = xlCenter
    .HorizontalAlignment = xlCenter
End With

Range("a1").Select

'冻结首行
With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
End With
ActiveWindow.FreezePanes = True

ActiveWorkbook.Close savechanges:=True



End Sub










'...............上周委托...............
Sub caoluw委托()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'打开委托原始数据表
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\entrustManage.xls"
'删除接单相关明细数据
'Dim jiedan As Byte
'jiedan = Rows("1").Find(what:="首次接单人员", lookat:=xlWhole).Column
'Columns(jiedan).Resize(, 4).Delete
'定义委托明细表

If Format(Now(), "0.0") - Format(Range("b2"), "0.0") < 12 Then
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\" & Format(Now() - Weekday(Now(), 2) - 6, "yyyy.mm.dd") & "-" & Format(Now() - Weekday(Now(), 2), "yyyy.mm.dd") & "委托.xlsx", FileFormat:=xlWorkbookDefault
Else
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\" & Month(Date - 7) & "." & Day(Date - 7) & "-" & Month(Date - 1) & "." & Day(Date - 1) & "委托.xlsx", FileFormat:=xlWorkbookDefault
End If

Dim wtsht As Worksheet
Set wtsht = ActiveWorkbook.Sheets(1)

'删除测试记录
If Not Cells.Find("测试", lookat:=xlPart) Is Nothing Then
Worksheets.Add
ActiveSheet.Name = "暂存"
Range("a1:i1").Value = Array("小区名称", "业主姓名", "业主电话", "意向价格(元)", "处理状态", "经纪人", "业务员编号", "部门", "备注")

Union([a1].Offset(1, 0), [b1].Offset(2, 0), [c1].Offset(3, 0), [d1].Offset(4, 0), [e1].Offset(5, 0), [f1].Offset(6, 0), [g1].Offset(7, 0), [h1].Offset(8, 0), [i1].Offset(9, 0)).Value = "*测试*"

wtsht.Activate
ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=Sheets("暂存").Range("a1:i10")
Range("a2:x5000").SpecialCells(xlCellTypeVisible).Delete
ActiveSheet.UsedRange.AutoFilter
ActiveSheet.AutoFilterMode = False
Sheets("暂存").Delete
End If

'插入日期
Dim i As Byte
i = Cells.Find("委托时间", lookat:=xlWhole).Column
Columns(i + 1).Insert
Cells(1, i + 1).Value = "riqi"


With Range(Cells(2, i + 1), Cells(Range("a5000").End(xlUp).Row, i + 1))
    .NumberFormat = "yyyy/mm/dd"
    .Formula = "=int(rc[-1])"
    .Value = .Value
End With

'将小区信息模糊处理
Dim k As Byte
k = Cells.Find("小区名称", lookat:=xlWhole).Column
Union(Columns(k + 1), Columns(k + 2), Columns(k + 3), Columns(k + 4)).Insert
'分列
With Columns(k)
.TextToColumns DataType:=xlDelimited, other:=True, otherchar:="("
.TextToColumns DataType:=xlDelimited, other:=True, otherchar:="（"
.TextToColumns DataType:=xlDelimited, other:=True, otherchar:="-"
End With
Union(Columns(k + 1), Columns(k + 2), Columns(k + 3), Columns(k + 4)).Delete

'打开匹配表
Workbooks.Open Filename:="E:\lele月工作记录\数据匹配与高级筛选201712updated.xlsx"
Sheets("中原网房源明细").Activate
wtsht.Activate
'插入战区
Columns(i + 4).Insert
Cells(1, i + 4).Value = "战区"
'匹配战区
With Range(Cells(2, i + 4), Cells(Range("a5000").End(xlUp).Row, i + 4))
    .NumberFormat = "general"
    .Formula = "=if(iserror(VLOOKUP(""*""&G2&""*"",[数据匹配与高级筛选201712updated.xlsx]中原网房源明细!$B$2:$D$65535,3,0)),"""",VLOOKUP(""*""&G2&""*"",[数据匹配与高级筛选201712updated.xlsx]中原网房源明细!$B$2:$D$65535,3,0))"
    .Value = .Value
End With



'整表调整格式
'水平居中
Cells.Select
With Selection
    .VerticalAlignment = xlCenter
    .HorizontalAlignment = xlCenter
End With
'列宽自适应
Columns("a:x").ColumnWidth = 18
'冻结首行
With ActiveWindow
    .SplitRow = 1
    .SplitColumn = 0
End With
ActiveWindow.FreezePanes = True
'文字
With Cells.Font
    .Name = "微软雅黑"
    .Size = 10
End With
'首行背景色
Range("a1").Select
With Range(Selection, Selection.End(xlToRight))
    .Interior.Color = RGB(0, 0, 0)
    .Font.Color = RGB(255, 255, 255)
    With .Find("riqi", lookat:=xlWhole)
        .Interior.Color = RGB(255, 255, 0)
        .Font.Color = RGB(0, 0, 0)
    End With
    .Find("小区名称", lookat:=xlWhole) = "小区"
    With .Find("小区", lookat:=xlWhole)
        .Interior.Color = RGB(255, 255, 0)
        .Font.Color = RGB(0, 0, 0)
    End With
    .Find("类型", lookat:=xlWhole) = "租售"
    With .Find("租售", lookat:=xlWhole)
        .Interior.Color = RGB(255, 255, 0)
        .Font.Color = RGB(0, 0, 0)
    End With
End With

ActiveWorkbook.Close savechanges:=True

End Sub








'...............上周直聊...............
Sub caoluw直聊()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'打开上周的房源匹配表并匹配出租售分类、模糊处理房源信息
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\talkAboutHouse.xls"
If Cells(1, 1).Value = "被聊天房源信息" Then
Rows("1").Delete
End If
Dim i As Byte
i = Rows("1").Find("租价", lookat:=xlWhole).Column
'匹配出租售分类
Cells(1, i + 1).Value = "租售"
With Range(Cells(2, i + 1), Cells(Range("a20000").End(xlUp).Row, i + 1))
    .Formula = "=IF(MAX(G2:H2)>MAX(H:H),""售"",""租"")"
    .Value = .Value
End With
Columns(i + 1).Cut
Columns(Rows("1").Find("面积", lookat:=xlWhole).Column).Insert shift:=xlToRight
'模糊处理房源信息
Dim k As Byte
k = Rows("1").Find("楼盘名", lookat:=xlWhole).Column
Union(Columns(k + 1), Columns(k + 2), Columns(k + 3), Columns(k + 4)).Insert
With Columns(k)
    .TextToColumns DataType:=xlDelimited, other:=True, otherchar:="("
    .TextToColumns DataType:=xlDelimited, other:=True, otherchar:="（"
    .TextToColumns DataType:=xlDelimited, other:=True, otherchar:="-"
End With
Union(Columns(k + 1), Columns(k + 2), Columns(k + 3), Columns(k + 4)).Delete

'新建直聊结果表
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\" & Format(Now() - Weekday(Now(), 2) - 6, "yyyy.mm.dd") & "-" & Format(Now() - Weekday(Now(), 2), "yyyy.mm.dd") & "直聊.xlsx", FileFormat:=xlWorkbookDefault


'打开直聊总表和匹配表
Workbooks.Open Filename:="E:\lele月工作记录\数据匹配与高级筛选201712updated.xlsx"
Workbooks.Open Filename:="E:\lele月工作记录\数据更新\直聊&约看&400\直聊总表.xlsx"

'筛选出上周数据并复制到新建的直聊结果表
ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=Workbooks("数据匹配与高级筛选201712updated.xlsx").Sheets("数据高级筛选20180104").Range("b46:h53")
Columns("a:t").Copy
Dim str2 As String
str2 = Dir("d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\*直聊*.xlsx", vbNormal)
Workbooks(str2).Sheets(1).Range("a1").PasteSpecial Paste:=xlPasteValues
Workbooks("直聊总表.xlsx").Close savechanges:=False

'调整发送消息时间和日期格式
Dim zlsht As Worksheet
Set zlsht = Workbooks(str2).Sheets(1)
zlsht.Range("a1").Select

Columns("b").NumberFormat = "yyyy/mm/dd hh:mm:ss"
Columns("c").NumberFormat = "yyyy/mm/dd"

'匹配出区董、小区、租售
Dim m As Byte, ll As Long
ll = Range("a100000").End(xlUp).Row
m = Rows("1").Find("DepartmentName", lookat:=xlWhole).Column
Cells(1, m + 1).Value = "区董"
With Range(Cells(2, m + 1), Cells(ll, m + 1))
    .Formula = "=VLOOKUP(K2,[数据匹配与高级筛选201712updated.xlsx]匹配区董20180104updated!$C:$F,4,0)"
    .Value = .Value
Workbooks("数据匹配与高级筛选201712updated.xlsx").Close savechanges:=False
Cells(1, m + 2).Value = "小区"
    .Offset(0, 1).Formula = "=VLOOKUP(L2,[talkAboutHouse.xls]Sheet0!$A:$C,2,0)"
    .Offset(0, 1).Value = .Offset(0, 1).Value
Cells(1, m + 3).Value = "租售"
    .Offset(0, 2).Formula = "=VLOOKUP(L2,[talkAboutHouse.xls]Sheet0!$A:$C,3,0)"
    .Offset(0, 2).Value = .Offset(0, 2).Value
End With

Workbooks("talkAboutHouse.xls").Close savechanges:=False

'将区董小区租售3列未匹配到的单元格为空
Union(Columns(m + 1), Columns(m + 2), Columns(m + 3)).SpecialCells(xlCellTypeConstants, xlErrors).Select
Selection.Value = ""

'将未匹配到的区董根据同一分行来合并填充
With ActiveSheet.UsedRange
    
    .AutoFilter field:=m, Criteria1:="<>--" _
    , Operator:=xlAnd
    .AutoFilter field:=m + 1, Criteria1:="<>"
End With

Union(Columns(m), Columns(m + 1)).Copy
Worksheets.Add
ActiveSheet.Name = "暂存"
Cells(1, 1).PasteSpecial Paste:=xlPasteValues
'去重
Range("a:b").RemoveDuplicates Columns:=Array(1, 2)

'填充
zlsht.Activate
ActiveSheet.AutoFilterMode = False
Columns(m + 2).Insert shift:=xlToRight
Cells(1, m + 2) = "区董"
With Range(Cells(2, m + 2), Cells(ll, m + 2))
    .Formula = "=IF(Q2<>"""",Q2,IF(ISERROR(VLOOKUP(P2,暂存!A:B,2,0)),"""",VLOOKUP(P2,暂存!A:B,2,0)))"
    .Value = .Value
End With

Sheets("暂存").Delete
Columns(m + 1).Delete


'整表调整格式
'水平居中
Cells.Select
With Selection
    .VerticalAlignment = xlCenter
    .HorizontalAlignment = xlCenter
End With
'列宽自适应
Columns("a:x").ColumnWidth = 14
'冻结首行
With ActiveWindow
    .SplitRow = 1
    .SplitColumn = 0
End With
ActiveWindow.FreezePanes = True
'文字
With Cells.Font
    .Name = "微软雅黑"
    .Size = 10
End With
'首行背景色
Range("a1").Select
With Range(Selection, Selection.End(xlToRight))
    .Interior.Color = RGB(0, 0, 0)
    .Font.Color = RGB(255, 255, 255)
    With .Find("riqi", lookat:=xlWhole)
        .Interior.Color = RGB(255, 255, 0)
        .Font.Color = RGB(0, 0, 0)
    End With
   
    With .Find("小区", lookat:=xlWhole)
        .Interior.Color = RGB(255, 255, 0)
        .Font.Color = RGB(0, 0, 0)
    End With
    
    With .Find("租售", lookat:=xlWhole)
        .Interior.Color = RGB(255, 255, 0)
        .Font.Color = RGB(0, 0, 0)
    End With
    
    With .Find("区董", lookat:=xlWhole)
        .Interior.Color = RGB(255, 255, 0)
        .Font.Color = RGB(0, 0, 0)
    End With
    
End With

ActiveWorkbook.Close savechanges:=True

Application.DisplayAlerts = False
Application.ScreenUpdating = False
End Sub




Sub caoluw约看()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'打开约看总表
Dim ykstr As String
ykstr = Dir("d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\约看数据-截至*.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\" & ykstr
Dim ykwbk As Workbook
Set ykwbk = Workbooks(ykstr)


'依次打开各类约看表，清洗后粘贴至约看总表
Dim ii As Integer
For ii = 1 To 8
Dim ykstr2 As String
ykstr2 = Dir("d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\*y" & ii & "*.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\" & ykstr2
Rows("1:2").Delete
Columns(1).Delete
Dim actsht As Worksheet
Set actsht = ActiveSheet



If Not Rows("1").Find(what:="客户姓名", lookat:=xlPart) Is Nothing Then

    If (Not Columns(Rows("1").Find(what:="客户姓名", lookat:=xlPart).Column).Find(what:="测试", lookat:=xlPart) Is Nothing) Or ii = 7 Then
    
        If ii = 7 Then
            Columns(Rows("1").Find("小区编号", lookat:=xlPart).Column).Delete
            Columns(Rows("1").Find("小区名称", lookat:=xlPart).Column).Delete
            Columns(Rows("1").Find("房源编号", lookat:=xlPart).Column).Delete
            Columns(Rows("1").Find("房源名称", lookat:=xlPart).Column).Delete

            Columns(Rows("1").Find("地址", lookat:=xlPart).Column + 1).Resize(, 3).Insert
            With Columns(Rows("1").Find("地址", lookat:=xlPart).Column)
                .TextToColumns DataType:=xlDelimited, other:=True, otherchar:="("
                .TextToColumns DataType:=xlDelimited, other:=True, otherchar:="（"
                .TextToColumns DataType:=xlDelimited, other:=True, otherchar:="-"
            End With

            Columns(Rows("1").Find("地址", lookat:=xlPart).Column + 1).Resize(, 3).Delete
        End If

        
    ActiveSheet.UsedRange.AutoFilter field:=Rows("1").Find(what:="客户姓名", lookat:=xlPart).Column, Criteria1:="*测试*"
    Rows("2:10000").SpecialCells(xlCellTypeVisible).Delete
    ActiveSheet.AutoFilterMode = False
    Range(Range("a2"), Cells(Range("a2").End(xlDown).Row, Cells(1, 100).End(xlToLeft).Column)).Copy
    Application.Goto ykwbk.Sheets(ii).Range("a1")
    ykwbk.Sheets(ii).Range("a6556").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    ElseIf Application.WorksheetFunction.CountA(Columns(1)) > 2 Then
    Range(Range("a2"), Cells(Range("a2").End(xlDown).Row, Cells(1, 100).End(xlToLeft).Column)).Copy
    Application.Goto ykwbk.Sheets(ii).Range("a1")
    ykwbk.Sheets(ii).Range("a6556").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

    End If

Else
Range(Range("a2"), Cells(Range("a2").End(xlDown).Row, Cells(1, 100).End(xlToLeft).Column)).Copy
Application.Goto ykwbk.Sheets(ii).Range("a1")
ykwbk.Sheets(ii).Range("a6556").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If

actsht.Activate
ActiveWorkbook.Close savechanges:=True

Next



'约看总表另存为
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\上周直聊委托约看400\约看数据-截至" & Format(Now() - Weekday(Now(), 2), "yyyy.mm.dd") & "新.xlsx", FileFormat:=xlWorkbookDefault
ActiveWorkbook.Close savechanges:=True

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