zy网上月投入产出

最新推荐文章于 2021-11-27 17:06:36 发布
gulie8
最新推荐文章于 2021-11-27 17:06:36 发布
阅读量149
点赞数
分类专栏： VBA
本文链接：https://blog.csdn.net/gulie8/article/details/102778735
版权
VBA 专栏收录该内容
9 篇文章 0 订阅
订阅专栏
Option Explicit

'************************************中原网上月投入产出*************************
Sub zyroi()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Call ctmroi
Call ptmroi
Call zydata

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



'************************************CTM投入产出表*************************
Sub ctmroi()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'定义ctm文档及原表
Dim ctmname As String
ctmname = Dir("d:\Users\zhanggl21\Desktop\6666\上月中原网月度成交数据\*CTM成交来电数据*.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月中原网月度成交数据\" & ctmname
Dim ctmsht As Worksheet
Set ctmsht = Sheets(1)

'删除来电来源为"金铺"的记录
Dim aa As Byte
aa = Rows("1").Find("来电来源", lookat:=xlWhole).Column
If Not Cells.Find("金铺", lookat:=xlWhole) Is Nothing Then
Cells.AutoFilter field:=aa, Criteria1:="=金铺"
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
'退出自动筛选
ActiveSheet.AutoFilterMode = False
End If

'在“来电来源”列右侧插入多列
Columns(aa + 1).Resize(, 6).Insert
With Range(Cells(1, aa + 1), Cells(1, aa + 6))
    .Value = Array("成交网站", "成交渠道", "月份", "单数(拆分)", "业绩(拆分)", "网站个数")
'处理成黑字黄底色
    .Interior.Color = RGB(255, 255, 0)
    .Font.Color = RGB(0, 0, 0)
End With


'求出最后一行的行号
Dim ctmrow As Integer
ctmrow = Range("a1").End(xlDown).Row

'统一表格式
Rows("2").Copy
Rows("2:" & ctmrow).PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
'给表格添加框线
ActiveSheet.UsedRange.Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
    End With
    
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
    End With
    
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
    End With
  
  
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
    End With
    

'匹配成交网站
With Range(Cells(2, aa + 1), Cells(ctmrow, aa + 1))
    .Formula = "=IF(COUNT(FIND(""中原"",U2),FIND(""网易线下"",U2))>0,""中原网"",U2)"
    .Value = .Value
End With

'匹配成交渠道
With Range(Cells(2, aa + 2), Cells(ctmrow, aa + 2))
    .Formula = "=IF(ISNUMBER(FIND(""400电话"",U2)),""400电话"",IF(ISNUMBER(FIND(""在线委托"",U2)),""在线委托"",IF(ISNUMBER(FIND(""直聊"",U2)),""直聊"",IF(ISNUMBER(FIND(""网易线下"",U2)),""网易线下"",U2))))"
    .Value = .Value
End With

'匹配月份
With Range(Cells(2, aa + 3), Cells(ctmrow, aa + 3))
    .NumberFormatLocal = "yyyy""年""m""月"";@"
    .Formula = "=YEAR(K2)&""年""&MONTH(K2)&""月"""
    .Value = .Value
End With

'计算各单(成交编号)的来电网站个数
Union(Columns(Rows("1").Find("Root Id", lookat:=xlWhole).Column), Columns(aa + 1)).Copy
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "暂存"
Range("a1").PasteSpecial (xlPasteValues)
'成交编号和成交网站两列去重
Union(Columns(1), Columns(2)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
'得出个数
Dim bb As Integer
bb = Cells(1, 1).End(xlDown).Row
Cells(1, 3).Value = "网站个数"
With Range("c2:c" & bb)
    .Formula = "=countif(a:a,a2)"
    .Value = .Value
End With

'在ctm表中填入各单的网站个数
ctmsht.Activate
With Range(Cells(2, aa + 6), Cells(ctmrow, aa + 6))
    .Formula = "=VLOOKUP(B2,暂存!A:C,3,0)"
    .Value = .Value
End With

'在ctm表中填入拆分单数
With Range(Cells(2, aa + 4), Cells(ctmrow, aa + 4))
    .Formula = "=1/aa2"
    .Value = .Value
End With

'在ctm表中填入拆分业绩
With Range(Cells(2, aa + 5), Cells(ctmrow, aa + 5))
    .Formula = "=f2/aa2"
    .Value = .Value
End With


'删除暂存表
Sheets("暂存").Delete

'新建单数业绩表与客户表
Worksheets.Add after:=Sheets(Sheets.Count), Count:=2
Sheets(2).Name = "单数与业绩"
Sheets(3).Name = "客"

'将成交编号、成交类型、成交网站、月份、单数(拆分)、业绩(拆分)6列复制到sheet[单数与业绩]
ctmsht.Activate
Union(Columns(Rows("1").Find("Root Id", lookat:=xlWhole).Column), Columns(Rows("1").Find("成交类型", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("成交网站", lookat:=xlWhole).Column), Columns(Rows("1").Find("月份", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("单数(拆分)", lookat:=xlWhole).Column), Columns(Rows("1").Find("业绩(拆分)", lookat:=xlWhole).Column)).Copy _
Destination:=Sheets("单数与业绩").Range("a1")

'将客户类型、成交类型、来电客户电话、成交网站、月份、单数(拆分)6列复制到sheet[客]
Union(Columns(Rows("1").Find("客户类型", lookat:=xlWhole).Column), Columns(Rows("1").Find("成交类型", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("来电客户电话", lookat:=xlWhole).Column), Columns(Rows("1").Find("成交网站", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("月份", lookat:=xlWhole).Column), Columns(Rows("1").Find("单数(拆分)", lookat:=xlWhole).Column)).Copy _
Destination:=Sheets("客").Range("a1")

'在sheet[单数与业绩]用数据透视表生成结果
Sheets("单数与业绩").Activate
  Columns("A:F").Select
    ActiveSheet.Range("$A:$F").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), _
        Header:=xlYes
    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "单数与业绩!R1C1:R5000C6", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="单数与业绩!R1C11", TableName:="单数与业绩透视表", DefaultVersion:= _
        xlPivotTableVersion14
    Sheets("单数与业绩").Select
    Cells(1, 11).Select
    With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("月份")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("成交网站")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("成交类型")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("单数与业绩透视表").AddDataField ActiveSheet.PivotTables("单数与业绩透视表" _
        ).PivotFields("单数(拆分)"), "求和项:单数(拆分)", xlSum
    ActiveSheet.PivotTables("单数与业绩透视表").AddDataField ActiveSheet.PivotTables("单数与业绩透视表" _
        ).PivotFields("业绩(拆分)"), "求和项:业绩(拆分)", xlSum
        
   With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("月份")
        .PivotItems("(blank)").Visible = False
        .AutoSort xlDescending, "月份"
    End With
    
 
    With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("求和项:单数(拆分)")
        .NumberFormat = "0.00_);(0.00)"
    End With
    With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("求和项:业绩(拆分)")
        .NumberFormat = "#,##0_);(#,##0)"
    End With




'在sheet[客]用数据透视表生成结果
Sheets("客").Activate
  Columns("A:F").Select
    ActiveSheet.Range("$A:$F").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), _
        Header:=xlYes
   
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "客!R1C1:R5000C6", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="客!R1C11", TableName:="客户数透视表", DefaultVersion:= _
        xlPivotTableVersion14
    Sheets("客").Select
    Cells(1, 11).Select
    With ActiveSheet.PivotTables("客户数透视表").PivotFields("月份")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("客户数透视表").PivotFields("成交网站")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("客户数透视表").PivotFields("客户类型")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("客户数透视表").PivotFields("成交类型")
        .Orientation = xlColumnField
        .Position = 2
    End With
    ActiveSheet.PivotTables("客户数透视表").AddDataField ActiveSheet.PivotTables("客户数透视表" _
        ).PivotFields("单数(拆分)"), "求和项:单数(拆分)", xlSum
 
 With ActiveSheet.PivotTables("客户数透视表").PivotFields("月份")
        .PivotItems("(blank)").Visible = False
    End With
    

 
    With ActiveSheet.PivotTables("客户数透视表").PivotFields("求和项:单数(拆分)")
        .NumberFormat = "0.00_);(0.00)"
    End With

    ActiveSheet.PivotTables("客户数透视表").PivotFields("月份").AutoSort xlDescending, "月份"

'保存
ActiveWorkbook.Close savechanges:=True

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










'************************************PTM投入产出表*************************
Sub ptmroi()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'定义ctm文档及原表
Dim ptmname As String
ptmname = Dir("d:\Users\zhanggl21\Desktop\6666\上月中原网月度成交数据\*PTM成交来电数据*.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月中原网月度成交数据\" & ptmname
Dim ptmsht As Worksheet
Set ptmsht = Sheets(1)

'删除来电网站为"金铺"的记录
Dim aa As Byte
aa = Rows("1").Find("来电网站", lookat:=xlWhole).Column
If Not Cells.Find("金铺", lookat:=xlWhole) Is Nothing Then
Cells.AutoFilter field:=aa, Criteria1:="=金铺"
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
'退出自动筛选
ActiveSheet.AutoFilterMode = False
End If

'在“来电网站”列右侧插入多列
Columns(aa + 1).Resize(, 6).Insert
With Range(Cells(1, aa + 1), Cells(1, aa + 6))
    .Value = Array("成交网站", "成交渠道", "月份", "单数(拆分)", "业绩(拆分)", "网站个数")
    .Interior.Color = RGB(255, 255, 0)
    .Font.Color = RGB(0, 0, 0)
End With


'求出最后一行的行号
Dim ptmrow As Integer
ptmrow = Range("a1").End(xlDown).Row

'统一表格式
Rows("2").Copy
Rows("2:" & ptmrow).PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
'给表格添加框线
ActiveSheet.UsedRange.Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
    End With
    
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
    End With
    
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
    End With
  
  
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
    End With

'匹配成交网站
With Range(Cells(2, aa + 1), Cells(ptmrow, aa + 1))
    .Formula = "=IF(COUNT(FIND(""中原"",r2),FIND(""网易线下"",r2))>0,""中原网"",r2)"
    .Value = .Value
End With

'匹配成交渠道
With Range(Cells(2, aa + 2), Cells(ptmrow, aa + 2))
    .Formula = "=IF(ISNUMBER(FIND(""400电话"",r2)),""400电话"",IF(ISNUMBER(FIND(""在线委托"",r2)),""在线委托"",IF(ISNUMBER(FIND(""直聊"",r2)),""直聊"",IF(ISNUMBER(FIND(""网易线下"",r2)),""网易线下"",r2))))"
    .Value = .Value
End With

'匹配月份
With Range(Cells(2, aa + 3), Cells(ptmrow, aa + 3))
    .NumberFormatLocal = "yyyy""年""m""月"";@"
    .Formula = "=YEAR(c2)&""年""&MONTH(c2)&""月"""
    .Value = .Value
End With

'计算各单(成交编号)的来电网站个数
Union(Columns(Rows("1").Find("成交编号", lookat:=xlWhole).Column), Columns(aa + 1)).Copy
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "暂存"
Range("a1").PasteSpecial (xlPasteValues)
'成交编号和成交网站两列去重
Union(Columns(1), Columns(2)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
'得出个数
Dim bb As Integer
bb = Cells(1, 1).End(xlDown).Row
Cells(1, 3).Value = "网站个数"
With Range("c2:c" & bb)
    .Formula = "=countif(a:a,a2)"
    .Value = .Value
End With

'在ptm表中填入各单的网站个数
ptmsht.Activate
With Range(Cells(2, aa + 6), Cells(ptmrow, aa + 6))
    .Formula = "=VLOOKUP(B2,暂存!A:C,3,0)"
    .Value = .Value
End With

'在ptm表中填入拆分单数
With Range(Cells(2, aa + 4), Cells(ptmrow, aa + 4))
    .Formula = "=1/x2"
    .Value = .Value
End With

'在ptm表中填入拆分业绩
With Range(Cells(2, aa + 5), Cells(ptmrow, aa + 5))
    .Formula = "=g2/x2"
    .Value = .Value
End With

'删除暂存表
Sheets("暂存").Delete

'新建单数业绩表与客户表
Worksheets.Add after:=Sheets(Sheets.Count), Count:=2
Sheets(2).Name = "单数与业绩"
Sheets(3).Name = "客"

'将成交编号、交易类型、成交网站、月份、单数(拆分)、业绩(拆分)6列复制到sheet[单数与业绩]
ptmsht.Activate
Range("a1").Select

Union(Columns(Rows("1").Find("成交编号", lookat:=xlPart).Column), _
Columns(Rows("1").Find("交易类型", lookat:=xlPart).Column), _
Columns(Rows("1").Find("成交网站", lookat:=xlPart).Column), _
Columns(Rows("1").Find("月份", lookat:=xlPart).Column), _
Columns(Rows("1").Find("单数(拆分)", lookat:=xlPart).Column), _
Columns(Rows("1").Find("业绩(拆分)", lookat:=xlPart).Column)).Copy Destination:=Sheets("单数与业绩").Range("a1")

'将交易类型、来电号码、成交网站、月份、单数(拆分)5列复制到sheet[客]
Union(Columns(Rows("1").Find("交易类型", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("来电号码", lookat:=xlWhole).Column), Columns(Rows("1").Find("成交网站", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("月份", lookat:=xlWhole).Column), Columns(Rows("1").Find("单数(拆分)", lookat:=xlWhole).Column)).Copy Destination:=Sheets("客").Range("a1")

'在sheet[单数与业绩]用数据透视表生成结果
'去重
Sheets("单数与业绩").Activate
    ActiveSheet.Range("$A:$F").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), _
        Header:=xlYes
 '将成交类型全部转为买卖
 Columns(2).Replace "租赁", "买卖"
    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "单数与业绩!R1C1:R5000C6", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="单数与业绩!R1C11", TableName:="单数与业绩透视表", DefaultVersion:= _
        xlPivotTableVersion14
    Sheets("单数与业绩").Select
    Cells(1, 11).Select
    With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("月份")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("成交网站")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("交易类型")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("单数与业绩透视表").AddDataField ActiveSheet.PivotTables("单数与业绩透视表" _
        ).PivotFields("单数(拆分)"), "求和项:单数(拆分)", xlSum
    ActiveSheet.PivotTables("单数与业绩透视表").AddDataField ActiveSheet.PivotTables("单数与业绩透视表" _
        ).PivotFields("业绩(拆分)"), "求和项:业绩(拆分)", xlSum
   
   With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("月份")
        .PivotItems("(blank)").Visible = False
    End With
    
   ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("月份").AutoSort xlDescending, "月份"
 
    With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("求和项:单数(拆分)")
        .NumberFormat = "0.00_);(0.00)"
    End With
    With ActiveSheet.PivotTables("单数与业绩透视表").PivotFields("求和项:业绩(拆分)")
        .NumberFormat = "#,##0_);(#,##0)"
    End With




'在sheet[客]用数据透视表生成结果
Sheets("客").Activate
  Columns("A:e").Select
    ActiveSheet.Range("$A:$F").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
        Header:=xlYes
    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "客!R1C1:R5000C5", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="客!R1C11", TableName:="客户数透视表", DefaultVersion:= _
        xlPivotTableVersion14
    Sheets("客").Select
    Cells(1, 11).Select
    With ActiveSheet.PivotTables("客户数透视表").PivotFields("月份")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("客户数透视表").PivotFields("成交网站")
        .Orientation = xlRowField
        .Position = 2
    End With

    With ActiveSheet.PivotTables("客户数透视表").PivotFields("交易类型")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("客户数透视表").AddDataField ActiveSheet.PivotTables("客户数透视表" _
        ).PivotFields("单数(拆分)"), "求和项:单数(拆分)", xlSum
 
With ActiveSheet.PivotTables("客户数透视表").PivotFields("月份")
        .PivotItems("(blank)").Visible = False
    End With
 
    With ActiveSheet.PivotTables("客户数透视表").PivotFields("求和项:单数(拆分)")
        .NumberFormat = "0.00_);(0.00)"
    End With

    ActiveSheet.PivotTables("客户数透视表").PivotFields("月份").AutoSort xlDescending, "月份"
    
'保存
ActiveWorkbook.Close savechanges:=True

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub




























'************************************将结果填入中原网月度投入产出表*************************
Sub zydata()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'打开中原网投入产出结果excel
Dim str As String
str = Dir("E:\lele月工作记录\电商发展部月度总结汇报\*中原网数据-张光乐.xlsx", vbNormal)
Workbooks.Open Filename:="E:\lele月工作记录\电商发展部月度总结汇报\" & str

'新建3张表
Sheets(Array(3, 4, 5)).Delete
Worksheets.Add after:=Sheets(Sheets.Count), Count:=3
Sheets(3).Name = "ctm"
Sheets(4).Name = "ptm"
Sheets(5).Name = "总体投入产出"

'打开当月ctm结果表
Dim str1 As String
str1 = Dir("d:\Users\zhanggl21\Desktop\6666\上月中原网月度成交数据\*CTM成交来电数据.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月中原网月度成交数据\" & str1
'将所需列的数据复制粘贴到中原网投入产出结果ctm表
Sheets(1).Activate
Union(Columns(Rows("1").Find("Root Id", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("成交金额", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("CTM业绩", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("成交类型", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("成交渠道", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("月份", lookat:=xlWhole).Column)).Copy Destination:=Workbooks(str).Sheets(3).Range("a1")
Workbooks(str1).Close savechanges:=False

'打开当月ptm结果表
Dim str2 As String
str2 = Dir("d:\Users\zhanggl21\Desktop\6666\上月中原网月度成交数据\*PTM成交来电数据*.xlsx", vbNormal)
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\上月中原网月度成交数据\" & str2
'将所需列的数据复制粘贴到中原网投入产出结果ptm表
Sheets(1).Activate
Union(Columns(Rows("1").Find("成交编号", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("总业绩", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("总价", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("交易类型", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("成交渠道", lookat:=xlWhole).Column), _
Columns(Rows("1").Find("月份", lookat:=xlPart).Column)).Copy Destination:=Workbooks(str).Sheets(4).Range("a1")
Workbooks(str2).Close savechanges:=False

'将中原网投入产出数据工作簿里cm表的成交渠道与月份调换
Workbooks(str).Sheets(3).Activate
Columns(5).Cut
Columns(7).Insert shift:=xlToLeft
'所有列整体去重
Columns("a:f").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), Header:=xlYes
'计算ctm记录数
Dim ctmk As Integer
ctmk = Range("a1").End(xlDown).Row
'将ctm记录复制到总体投入产出表
Range(Cells(2, 1), Cells(ctmk, "f")).Copy Destination:=Sheets(5).Range("b2")
'在总体投入产出表中将这些记录标记为"二手"
Sheets(5).Activate
Range("a1:g1") = Array("一手二手", "成交编号", "成交金额", "业绩", "成交类型", "月份", "成交渠道")
Range("a2:a" & ctmk).Value = "二手"



'将中原网投入产出数据工作簿里ptm表的总价与总业绩调换
Workbooks(str).Sheets(4).Activate
Columns(3).Cut
Columns(2).Insert shift:=xlToRight
'并将ptm表的成交渠道与月份调换
Columns(5).Cut
Columns(7).Insert shift:=xlToLeft
'并将ptm表里的成交类型的"租赁"改成"买卖"
Columns(4).Replace "租赁", "买卖"
'所有列整体去重
Columns("a:f").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), Header:=xlYes
'计算ptm记录数
Dim ptmk As Integer
ptmk = Range("a1").End(xlDown).Row
'将ptm记录复制到总体投入产出表
Range(Cells(2, 1), Cells(ptmk, "f")).Copy Destination:=Sheets(5).Cells(ctmk + 1, 2)

'在总体投入产出表中将这些记录标记为"一手"
Sheets(5).Activate
Range(Cells(ctmk + 1, 1), Cells(ctmk + ptmk - 1, 1)).Value = "一手"

'列宽自适应
Columns("a:g").AutoFit

'匹配出网站来源并只保留成交渠道为中原网的记录
Range("h1").Value = "网站"
With Range("h2:h" & ctmk + ptmk - 1)
    .Formula = "=IF(COUNT(FIND(""400电话"",g2),FIND(""网易线下"",g2),find(""委托"",g2),find(""直聊"",g2))>0,""中原网"",g2)"
    .Value = .Value
End With

ActiveSheet.UsedRange.AutoFilter field:=8, Criteria1:="<>中原网"
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
ActiveSheet.AutoFilterMode = False
Columns("g:h").Delete
Range("a1").Select
'对所有列整体去重
Columns("a:f").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), Header:=xlYes

'生成结果(数据透视表)
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "总体投入产出!R1C1:R10000C6", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="总体投入产出!R1C11", TableName:="总体投入产出", DefaultVersion:= _
        xlPivotTableVersion14
    
    Cells(1, 11).Select
    With ActiveSheet.PivotTables("总体投入产出").PivotFields("月份")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("总体投入产出").PivotFields("一手二手")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("总体投入产出").AddDataField ActiveSheet.PivotTables("总体投入产出" _
        ).PivotFields("成交编号"), "计数项:成交编号", xlCount
    ActiveSheet.PivotTables("总体投入产出").AddDataField ActiveSheet.PivotTables("总体投入产出" _
        ).PivotFields("业绩"), "求和项:业绩", xlSum
    ActiveSheet.PivotTables("总体投入产出").AddDataField ActiveSheet.PivotTables("总体投入产出" _
        ).PivotFields("成交金额"), "求和项:成交金额", xlSum
        
    With ActiveSheet.PivotTables("总体投入产出").PivotFields("月份")
        .PivotItems("(blank)").Visible = False
    End With
    
    ActiveSheet.PivotTables("总体投入产出").PivotFields("月份").AutoSort xlDescending, "月份"

    
 '生成各渠道ctm结果(数据透视表)
 Sheets(3).Activate
 
 ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "ctm!R1C1:R10000C6", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="ctm!R1C11", TableName:="ctm", DefaultVersion:= _
        xlPivotTableVersion14
  
    Cells(1, 11).Select
    With ActiveSheet.PivotTables("ctm").PivotFields("月份")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("ctm").PivotFields("成交渠道")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("ctm").PivotFields("成交类型")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("ctm").AddDataField ActiveSheet.PivotTables("ctm" _
        ).PivotFields("Root Id"), "计数项:Root Id", xlCount
    ActiveSheet.PivotTables("ctm").AddDataField ActiveSheet.PivotTables("ctm" _
        ).PivotFields("CTM业绩"), "求和项:CTM业绩", xlSum
    ActiveSheet.PivotTables("ctm").AddDataField ActiveSheet.PivotTables("ctm" _
        ).PivotFields("成交金额"), "求和项:成交金额", xlSum

    With ActiveSheet.PivotTables("ctm").PivotFields("月份")
        .PivotItems("(blank)").Visible = False
    End With

ActiveSheet.PivotTables("ctm").PivotFields("月份").AutoSort xlDescending, "月份"



 '生成各渠道ptm结果(数据透视表)
 Sheets(4).Activate
 
 ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "ptm!R1C1:R10000C6", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="ptm!R1C11", TableName:="ptm", DefaultVersion:= _
        xlPivotTableVersion14
        
    Cells(1, 11).Select
    With Sheets(4).PivotTables("ptm").PivotFields("月份")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("ptm").PivotFields("成交渠道")
        .Orientation = xlRowField
        .Position = 2
    End With
    
    With ActiveSheet.PivotTables("ptm").PivotFields("交易类型")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables("ptm").AddDataField ActiveSheet.PivotTables("ptm" _
        ).PivotFields("成交编号"), "计数项:成交编号", xlCount
    ActiveSheet.PivotTables("ptm").AddDataField ActiveSheet.PivotTables("ptm" _
        ).PivotFields("总业绩"), "求和项:总业绩", xlSum
    ActiveSheet.PivotTables("ptm").AddDataField ActiveSheet.PivotTables("ptm" _
        ).PivotFields("总价"), "求和项:总价", xlSum
 
     With ActiveSheet.PivotTables("ptm").PivotFields("月份")
        .PivotItems("(blank)").Visible = False
        
        ActiveSheet.PivotTables("ptm").PivotFields("月份").AutoSort xlDescending, "月份"
    End With



'保存为新文档
ActiveWorkbook.SaveAs Filename:="E:\lele月工作记录\电商发展部月度总结汇报\" & Year(Date - 10) & "年" & (Month(Date) - 1) & "月" & "中原网数据-张光乐(新)"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
gulie8
关注
0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
zy网上月投入产出

Option Explicit'************************************中原网上月投入产出*************************Sub zyroi()Application.DisplayAlerts = FalseApplication.ScreenUpdating = FalseCall ctmroiCall ptmroiCall ...
复制链接

扫一扫
专栏目录