周0各qudong辖属楼盘电话直聊

于 2019-10-28 11:59:03 发布
阅读量105 收藏
点赞数
分类专栏： VBA
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/gulie8/article/details/102778763
版权 
Option Explicit

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

'新建结果工作簿并命名
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\上周各区董下属楼盘直聊电话\上周各区董下属楼盘直聊电话.xlsx", FileFormat:=xlWorkbookDefault
'在结果工作簿增加3张新表
Dim qdi As Byte
For qdi = 1 To 3
Worksheets.Add after:=Sheets(Worksheets.Count)
Next

'对4张表重命名
Sheets(1).Name = "电话"
Sheets(2).Name = "直聊"
Sheets(3).Name = "R电话"
Sheets(4).Name = "R直聊"

'打开数据源(上周电话明细表)并复制所需数据到"电话"表
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上周各区董下属楼盘直聊电话\上周400来电.xlsx"
'匹配区董
Dim qdk As Byte
qdk = Cells.Find("业务员工号", lookat:=xlWhole).Column
Columns(qdk + 1).Insert
Cells(1, qdk + 1) = "区董"
Workbooks.Open Filename:="E:\lele月工作记录\数据匹配与高级筛选201712updated.xlsx"
Workbooks("上周400来电.xlsx").Sheets(1).Activate
Range(Cells(2, qdk + 1), Cells(Range("a165656").End(xlUp).Row, qdk + 1)).Select
Selection.Formula = "=VLOOKUP(J2,[数据匹配与高级筛选201712updated.xlsx]匹配区董20180104updated!$C:$F,4,0)"
Selection.Value = Selection.Value
Workbooks("数据匹配与高级筛选201712updated.xlsx").Close savechanges:=False

'筛选出租售不为空的记录

ActiveSheet.UsedRange.AutoFilter field:=Cells.Find("租售", lookat:=xlWhole).Column, Criteria1:="<>"
Union(Columns(Cells.Find("ID", lookat:=xlWhole).Column), Columns(Cells.Find("riqi", lookat:=xlWhole).Column), Columns(Cells.Find("小区", lookat:=xlWhole).Column), Columns(Cells.Find("租售", lookat:=xlWhole).Column), Columns(Cells.Find("区董", lookat:=xlWhole).Column)).Select
Selection.Copy
'仅粘贴数值 (为了尽量减小结果文档的大小)
Workbooks("上周各区董下属楼盘直聊电话.xlsx").Sheets("电话").Range("a1").PasteSpecial Paste:=xlPasteValues
Workbooks("上周400来电.xlsx").Close savechanges:=False






'打开数据源(上周直聊明细表)并复制所需数据到"直聊"表
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上周各区董下属楼盘直聊电话\上周直聊.xlsx"
ActiveSheet.UsedRange.AutoFilter field:=Cells.Find("租售", lookat:=xlWhole).Column, Criteria1:="<>"
Union(Columns(Cells.Find("序号", lookat:=xlWhole).Column), Columns(Cells.Find("riqi", lookat:=xlWhole).Column), Columns(Cells.Find("小区", lookat:=xlWhole).Column), Columns(Cells.Find("租售", lookat:=xlWhole).Column), Columns(Cells.Find("区董", lookat:=xlWhole).Column)).Select
Selection.Copy
Workbooks("上周各区董下属楼盘直聊电话.xlsx").Sheets("直聊").Range("a1").PasteSpecial Paste:=xlPasteValues
Workbooks("上周直聊.xlsx").Close savechanges:=False


'电话表里区董未匹配标记
'电话表
Sheets("电话").Activate
Union(Columns(1), Columns(2), Columns(3), Columns(4), Columns(5)).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
Dim abc As Range, kkk As Byte
kkk = Rows(1).Find("区董", lookat:=xlWhole).Column

On Error Resume Next
Set abc = Columns(kkk).SpecialCells(xlCellTypeConstants, xlErrors)

If Not abc Is Nothing Then
Columns(kkk).SpecialCells(xlCellTypeConstants, xlErrors).Select
Selection.Value = "未匹配"
End If

'将区董列有"（兼管）"的去掉
Columns(kkk + 1).Insert
Cells(1, kkk + 1) = "区董"
With Range(Cells(2, kkk + 1), Cells(Range("a165566").End(xlUp).Row, kkk + 1))
    .NumberFormat = "general"
    .Formula = "=if(e2="""",""未匹配"",SUBSTITUTE(e2,""（兼管）"",""""))"
    .Value = .Value
End With
Columns(kkk).Delete


'直聊表(且将区董列有"（兼管）"的去掉)
'去重
Sheets("直聊").Activate
Union(Columns(1), Columns(2), Columns(3), Columns(4), Columns(5)).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes

Dim qd As Byte
qd = Cells.Find("区董", lookat:=xlWhole).Column
'将区董列有"（兼管）"的去掉
Columns(qd + 1).Insert
Cells(1, qd + 1) = "区董"
With Range(Cells(2, qd + 1), Cells(Range("a165566").End(xlUp).Row, qd + 1))
    .NumberFormat = "general"
    .Formula = "=if(c2="""",""未匹配"",SUBSTITUTE(c2,""（兼管）"",""""))"
    .Value = .Value
End With
Columns(qd).Delete

'生成电话数据透视表
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "电话!R1C1:R10000C5", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="R电话!R1C11", TableName:="数据透视表1", DefaultVersion:= _
        xlPivotTableVersion14
    Sheets("R电话").Select
    Cells(1, 11).Select
    With ActiveSheet.PivotTables("数据透视表1").PivotFields("区董")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("数据透视表1").PivotFields("小区")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("数据透视表1").PivotFields("租售")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("数据透视表1").AddDataField ActiveSheet.PivotTables("数据透视表1" _
        ).PivotFields("ID"), "求和项:ID", xlSum
    With ActiveSheet.PivotTables("数据透视表1").PivotFields("求和项:ID")
        .Caption = "计数项:ID"
        .Function = xlCount
    End With
    ActiveSheet.PivotTables("数据透视表1").PivotFields("小区").AutoSort xlDescending, _
        "计数项:ID"
    ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables("数据透视表1"), "租售"). _
        Slicers.Add ActiveSheet, , "租售", "租售", 183.75, 531, 144, 210
    ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables("数据透视表1"), "区董"). _
        Slicers.Add ActiveSheet, , "区董", "区董", 221.25, 568.5, 144, 210
    ActiveSheet.Shapes.Range(Array("区董")).Select
    ActiveSheet.Shapes("区董").IncrementLeft -492
    ActiveSheet.Shapes("区董").IncrementTop -201.75
    ActiveSheet.Shapes.Range(Array("租售")).Select
    ActiveSheet.Shapes("租售").IncrementLeft -209.25
    ActiveSheet.Shapes("租售").IncrementTop -165
    
    
    Sheets("直聊").Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "直聊!R1C1:R10000C5", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="R直聊!R1C11", TableName:="数据透视表2", DefaultVersion:= _
        xlPivotTableVersion14
    Sheets("R直聊").Select
    Cells(1, 11).Select
    With ActiveSheet.PivotTables("数据透视表2").PivotFields("区董")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("数据透视表2").PivotFields("小区")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("数据透视表2").PivotFields("租售")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("数据透视表2").AddDataField ActiveSheet.PivotTables("数据透视表2" _
        ).PivotFields("序号"), "求和项:序号", xlSum
    With ActiveSheet.PivotTables("数据透视表2").PivotFields("求和项:序号")
        .Caption = "计数项:序号"
        .Function = xlCount
    End With
    ActiveSheet.PivotTables("数据透视表2").PivotFields("小区").AutoSort xlDescending, _
        "计数项:序号"
    ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables("数据透视表2"), "区董"). _
        Slicers.Add ActiveSheet, , "区董 1", "区董", 183.75, 531, 144, 210
    ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables("数据透视表2"), "租售"). _
        Slicers.Add ActiveSheet, , "租售 1", "租售", 221.25, 568.5, 144, 210
    ActiveSheet.Shapes.Range(Array("租售 1")).Select
    ActiveSheet.Shapes.Range(Array("区董 1")).Select
    ActiveSheet.Shapes("区董 1").IncrementLeft -461.25
    ActiveSheet.Shapes("区董 1").IncrementTop -156
    ActiveSheet.Shapes.Range(Array("租售 1")).Select
    ActiveSheet.Shapes("租售 1").IncrementLeft -237.75
    ActiveSheet.Shapes("租售 1").IncrementTop -201.75
    Sheets(Array("电话", "直聊")).Select
    Sheets("直聊").Activate
    ActiveWindow.SelectedSheets.Visible = False
    Range("A1").Select


'生成直聊数据透视表


ActiveWorkbook.Close savechanges:=True

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

 

gulie8
关注
  • 0
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值