周0邀请码数据

Option Explicit
Sub yaoqingma()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'打开文档
Workbooks.Open Filename:="d:\Users\zhanggl21\Desktop\6666\邀请码数据\邀请码数据.xls"
'将文档另存为xlsx格式
ActiveWorkbook.SaveAs Filename:="d:\Users\zhanggl21\Desktop\6666\邀请码数据\邀请码数据-截至" & Year(Date - 1) & "年" & Month(Date - 1) & "月" & Day(Date - 1) & "日.xlsx", FileFormat:=xlWorkbookDefault

'删除首行无效标题
Rows("1").Delete

'筛选出[邀请员工]列不为空且有效的记录
ActiveSheet.UsedRange.AutoFilter field:=8, Criteria1:="<>", Operator:=xlAnd, Criteria2:="<>null"

'将注册时间、邀请员工、注册设备号三列复制到新表
Union(Columns(1), Columns(8), Columns(9)).Copy
Worksheets.Add
ActiveSheet.Range("a1").PasteSpecial Paste:=xlPasteValues

'删除原表
Sheets("sheet0").Delete

'删除无效记录(同一设备仅保留最早的一条)
'调整列宽
ActiveSheet.UsedRange.ColumnWidth = Application.CentimetersToPoints(0.5)
Range("d1").Value = "筛选"
'定义[注册设备号]列
Dim rng1 As Range, rng2 As Range
For Each rng1 In Range("c2:c" & Range("c1000").End(xlUp).Row)
    For Each rng2 In Range("c2:c" & Range("c1000").End(xlUp).Row)
    If rng2.Value = rng1.Value And rng2.Address <> rng1.Address And rng2.Offset(0, -2) > rng1.Offset(0, -2) Then
    rng2.Offset(0, 1) = 1
    ElseIf rng2.Value = rng1.Value And rng2.Address <> rng1.Address And rng2.Offset(0, -2) = rng1.Offset(0, -2) Then
    rng2.Offset(0, 1) = 1
    End If
    Next
Next
'筛选出无效列并删除之
Range("a2").Select
Selection.AutoFilter field:=4, Criteria1:="1"
Range("a2:x10000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp

'退出筛选状态
ActiveSheet.AutoFilterMode = False

'删除"筛选"辅助列
Columns(4).Delete

'将注册时间调整格式显示到时分秒
Range("a2:a" & Range("a10000").End(xlUp).Row).NumberFormat = "yyyy/mm/dd hh:mm:ss"

'添加日期列
Columns(2).Insert
Range("b1") = "日期"
With Range("b2:b" & Range("a10000").End(xlUp).Row)
    .Formula = "=int(a2)"
    .NumberFormat = "yyyy/mm/dd"
    .Value = .Value
End With

'根据员工编号匹配出员工姓名
Workbooks.Open Filename:="E:\lele月工作记录\数据匹配与高级筛选201712updated.xlsx"
Dim str3 As String
str3 = Dir("d:\Users\zhanggl21\Desktop\6666\邀请码数据\邀请码数据-截至*.xlsx", vbNormal)
Workbooks(str3).Sheets(1).Activate
Columns("d").Insert
Range("d1") = "员工姓名"
With Range("d2:d" & Range("a10000").End(xlUp).Row)
    .Formula = "=VLOOKUP(C2,[数据匹配与高级筛选201712updated.xlsx]匹配区董20180104updated!$C$2:$D$20000,2,0)"
    .Value = .Value
End With

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

'删除未匹配到员工姓名的记录
ActiveSheet.UsedRange.AutoFilter field:=4, Criteria1:="#N/A"
Range("a2:z1000").SpecialCells(xlCellTypeVisible).Select
Selection.Delete shift:=xlUp
ActiveSheet.AutoFilterMode = False


'创建数据透视表
    Range("B12").Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R229C5", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="Sheet1!R1C15", TableName:="数据透视表1", DefaultVersion:= _
        xlPivotTableVersion12
    Sheets("Sheet1").Select
    '把日期放到行标签区域
    Cells(1, 15).Select
    With ActiveSheet.PivotTables("数据透视表1").PivotFields("日期")
        .Orientation = xlRowField
        .Position = 1
    End With
     '把员工姓名放到行标签区域(日期下面)
    With ActiveSheet.PivotTables("数据透视表1").PivotFields("员工姓名")
        .Orientation = xlRowField
        .Position = 2
    End With
     '把注册设备号放到数值区域,并设置计算方式为计数
    ActiveSheet.PivotTables("数据透视表1").AddDataField ActiveSheet.PivotTables("数据透视表1" _
        ).PivotFields("注册设备号"), "计数项:注册设备号", xlCount
    '把数据透视表区域的各列列宽自适应
    Columns("O:Q").Select
    Columns("O:Q").EntireColumn.AutoFit
    '把自动汇总去掉
    Range("O4").Select
    ActiveSheet.PivotTables("数据透视表1").PivotFields("日期").Subtotals = Array(False, _
        False, False, False, False, False, False, False, False, False, False, False)
     '将数据透视表设置为以表格形式显示项目标签
Range("O2").Select
    With ActiveSheet.PivotTables("数据透视表1").PivotFields("日期")
        .LayoutForm = xlTabular
    End With
    '进行筛选只显示2017年10月31号之后的数据
    ActiveSheet.PivotTables("数据透视表1").PivotFields("日期").PivotFilters.Add Type:=xlAfter, Value1:="2017/10/31"
    '保存并退出结果文档
    ActiveWorkbook.Close savechanges:=True


'开启提示和屏幕刷新
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub