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