抖音直播报表数据预处理 VBA 程序分享


本程序适用于「抖音电商罗盘-商家视角-直播间明细」所导出报表,所有代码均已模块化标注,便于修改。

对比如图:
处理前
处理后

使用方法参见 Microsoft 官方文档:运行宏

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
Sub 数据预处理()
'<禁止屏幕刷新 Begin>
Excel.Application.ScreenUpdating = False
'<禁止屏幕刷新 End>
'<取消强制文本转换 Begin>
'选择列中已使用行
Range("F:AM").Resize(ActiveSheet.UsedRange.Rows.Count).Select
Dim selectRng As Range, arr As Variant
Set selectRng = Selection
'设置单元格为常规格式
selectRng.NumberFormatLocal = "G/通用格式"
'读取单元格数据,Excel根据数据特点自动转换格式
arr = selectRng.Value
selectRng.Value = arr
Set selectRng = Nothing
'<取消强制文本转换 End>
'<筛选-时间顺序排列 Begin>
Cells.AutoFilter
Application.ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range( _
"D1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With Application.ActiveSheet.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'<筛选-时间顺序排列 End>
'<插入列 Begin>
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("G:G").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'<插入列 End>
'<分列 Begin>
Columns("D:D").Select
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("F:F").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
'<分列 End>
'<直播日期、开始时间、结束时间列列头 Begin>
Range("D1").Select
ActiveCell.FormulaR1C1 = "直播日期"
Range("E1").Select
ActiveCell.FormulaR1C1 = "开始时间"
Range("G1").Select
ActiveCell.FormulaR1C1 = "结束时间"
'<直播日期、开始时间、结束时间列列头 End>
'<直播时长(小时)列插入、计算 Begin>
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I1").Select
ActiveCell.FormulaR1C1 = "直播时长(小时)"
Range("I2:I" & [e65536].End(xlUp).Row).Select
Selection.FormulaR1C1 = "=RC[-1]/60"
'<直播时长(小时)列插入、计算 End>
'<人均观看时长(秒)列插入、计算 Begin>
Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("Q1").Select
ActiveCell.FormulaR1C1 = "人均观看时长(秒)"
Range("Q2:Q" & [e65536].End(xlUp).Row).Select
Selection.FormulaR1C1 = "=RC[-1]*60"
'<人均观看时长(秒)列插入、计算 End>
'<直播间成交金额(含预售)列插入、计算 Begin>
Columns("AD:AD").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AD1").Select
ActiveCell.FormulaR1C1 = "直播间成交金额(含预售)"
Range("AD2:AD" & [e65536].End(xlUp).Row).Select
Selection.FormulaR1C1 = "=RC[-1]+RC[14]"
'<直播间成交金额(含预售)列插入、计算 End>
'<直播间成交订单数(含预售)列插入、计算 Begin>
Columns("AC:AC").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AC1").Select
ActiveCell.FormulaR1C1 = "直播间成交订单数(含预售)"
Range("AC2:AC" & [e65536].End(xlUp).Row).Select
Selection.FormulaR1C1 = "=RC[-1]+RC[15]"
'<直播间成交订单数(含预售)列插入、计算 End>
'<清除公式 Begin>
Columns("I:I").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Columns("Q:Q").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Columns("AC:AC").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Columns("AE:AE").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
'<清除公式 End>
'<删除无关列 Begin>
Range("A:C,F:F,H:H,K:K,P:P,S:S,U:U,W:W,Z:Z,AA:AB,AD:AD,AF:AF,AH:AH,AJ:AS").Delete Shift:=xlToLeft
'<删除无关列 End>
'<列调序 Begin>
Columns("F:G").Cut
Columns("E:E").Insert Shift:=xlToRight
Columns("H:I").Cut
Columns("F:F").Insert Shift:=xlToRight
Columns("Q:Q").Cut
Columns("I:I").Insert Shift:=xlToRight
Columns("Q:Q").Cut
Columns("J:J").Insert Shift:=xlToRight
Columns("S:S").Cut
Columns("K:K").Insert Shift:=xlToRight
Columns("Q:Q").Cut
Columns("M:M").Insert Shift:=xlToRight
Columns("R:R").Cut
Columns("N:N").Insert Shift:=xlToRight
Columns("S:S").Cut
Columns("O:O").Insert Shift:=xlToRight
Columns("R:R").Cut
Columns("Q:Q").Insert Shift:=xlToRight
'<列调序 End>
'<调整数值格式 Begin>
Range("D2:D" & [e65536].End(xlUp).Row).Select
Selection.NumberFormatLocal = "0.0"
Range("S2:S" & [e65536].End(xlUp).Row).Select
Selection.NumberFormatLocal = "0.0%"
'<调整数值格式 End>
'<清除当日未结束场次数据 Begin>
Dim tDay As Date
tDay = Format(Now, "yyyy/m/d")
If Range("A" & [e65536].End(xlUp).Row).Value = tDay Then
Rows(Range("A63336").End(3).Row).Delete
End If
'<清除当日未结束场次数据 End>
'<冻结窗格 Begin>
Range("B2").Select
ActiveWindow.FreezePanes = True
'<冻结窗格 End>
'<自动调整行高、列宽 Begin>
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
'<自动调整行高、列宽 End>
'<复位 Begin>
Range("A1").Select
'<复位 End>
'<启用屏幕刷新 Begin>
Excel.Application.ScreenUpdating = True
'<启用屏幕刷新 End>
End Sub