想成为魔法少女吗？来和VBA签订契约吧，浅谈公卫自动化报表。

# w" |* f) p; w6 ]" G5 V- ~7 z& M
+ ~$ q: ?0 m( Y0 X0 ~" q前言
" X: k. M) K3 K8 a3 e很久以前就想写的经验分享，关于公卫专业必备的excel表格、access数据库使用技能，通过合理的数据表布局、配合vba实现数据采集、自动清洗、分析、自动生成报表。无论是在国二十出台以前，还是乙类乙管落实后的现在，这些技能都显著提高了本人及所在医院对疫情处理的速度和准确性（以至于我们医院恶名远扬，因为无论卫贱委要多急或者多不合理的报表，我们总能给出来，被兄弟单位骂卷王）。
贴主营养食品专业，因此一些步骤可能流统的同学们有更好的办法，不足之处欢迎指出。本文主要做思路启发，目的在于让大家知道有这样一种方便的工具，可以提高我们的效率，并且无需过多的编程基础，学习曲线平缓。
( w2 u. Z. A7 b5 |5 B
6 z( {9 L" B$ F2 m5 U: O) H; I& O% Z

                               
登录/注册后可看大图

1 I7 q1 u& _* ?4 T; ?' T1. 关于VBA？
8 s2 Q; Y5 j& F9 v' h. O( X* @  ]VBA是office套件中内置的脚本环境，也被称作宏，官方文档：
9 f9 S# ?  V" f6 `9 G! u2 Fhttps://learn.microsoft.com/zh-cn/office/vba/api/overview/excel
基础知识：
! g, c8 l9 |+ k5 o; ~( G8 y$ G; shttps://www.w3cschool.cn/excelvba/
新手上路，以上两个链接直接看可能会头大，但是至少要先了解如何启用VBA功能：
1 H% a- T# z; b1 _https://www.w3cschool.cn/excelvba/excelvba-what.html
https://www.w3cschool.cn/excelvba/excelvba-macro.html
5 d$ R. _% R7 C  y

2. VBA在EXCEL报表中能做什么？
, g; P) A- K* X. l! U& t
场景1：如，从其他单位接收电子表格，为疫情触网对象信息，接报单位需要核实接收的信息并落实管理，其中列内容基本固定但是某些列会出现一些经常性的错误（比如地址、身份证号、性别年龄）

: @! r7 E: m( b  Q) \通过简单的公式，我们可以根据身份证号快速计算当事人的性别和年龄，以下是不太准确但方便的算法（假设身份证号位于A1单元格）：

1. =IF(MOD(MID(A1,17,1),2)=1,"男","女")
   8 x2 R$ H9 m6 H3 r! i0 W
2. =YEAR(TODAY())-MID(A1,7,4)

复制代码

1 c$ k. H$ \% I0 j: `- t年龄是粗暴地用当前年减去出生年，如果需要更准确的年龄，可以进一步修改公式
( s* K5 J! O1 Q& f
对于地址，我们经常会遇到形如下的错误地址：
; I+ N- y6 ^8 q2 ?上海市上海市市辖区浦东新区上钢街道昌里路360号
上海是市辖区浦东新区上钢新村街道昌里路360号
上海市上 钢街道昌里 路 360号
: E5 `; p& L# w& B" x8 ^上海市黄埔区南京东路街道成都北路290号（上海黄浦，广州黄埔）
  T( g6 ]. j/ C2 w上海市        荣乐西路1039弄1039号（上海的地址格式以弄、号、室为常见，部分地址没有弄只有号，流调人员可能不熟悉地址，因此一定要当事人报一个弄）

对于上述类型的部分错误，我们可以通过ctrl-h呼出替换窗口，把上海市、浦东新区、“ ”等常见的错误字符替换成""，替换后即可得到如下地址信息
昌里路360号
昌里路360号
昌里路360号
成都北路290号
荣乐西路1039弄1039号
0 K) e9 I: v0 T但是如果每天接报10-20单，数百人，这样处理可能会非常辛苦，可以利用如下VBA代码将常见的错误字段自动移除：

1. Sub 自动清理()
   
2.     ' 地址清理 宏
   
3.     ActiveWorkbook.Worksheets("纳管汇总表").Activate
   : q9 H, T/ v" N: D6 \6 q* t
4.     '由于我们还有其他自动计算脚本引用了地址，所以需要在更新地址时关闭自动计算功能以提升性能
   % L" t! L1 j, O: Q5 C
5.     Excel.Application.Calculation = xlCalculationManual
   
6.     Sheets("纳管汇总表").Select
   ' {5 Y( G. L* ~/ h+ @3 c
7.     '假设地址信息在H列
   
8.     With Sheets("纳管汇总表").Columns("H:H")
   9 c" z; S/ ~7 o- P* G- I6 U
9.         .Replace What:="上海市", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
   
10.         .Replace What:="上海是", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
11.         .Replace What:="市辖区", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
12.         .Replace What:="XX区", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
13.         .Replace What:="XX街道", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
14.         .Replace What:="XX居委", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    5 a& o- N' F- a. _9 ?2 A3 o
15.         .Replace What:="XX居委", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
16.         .Replace What:="XX居委", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    + B3 F0 t" {# b! B' U) }
17.         .Replace What:="XX居委", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
18.         .Replace What:="XX居委", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    - `) p' B1 D8 J8 k  j/ v
19.         .Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
20.         .Replace What:="    ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    . P4 v4 C3 B0 E/ ]( K
21.     End With
    : U) j* \+ D0 {/ D6 m- v! g' ~& r
22.     '重新打开自动计算
    " ?3 v4 ]4 v- k: U7 ~
23.     Excel.Application.Calculation = xlCalculationAutomatic
    ! g( ]+ W1 l9 L  t6 Z/ x( B+ J, {
24. End Sub
    ; F6 h3 G. k, O. l: G, X

复制代码

上述代码还可以实现批量的常见错误信息更正，或者字段替换，.Replace What:="A", Replacement:="B"，可以把A换成B

8 y1 i, ?( K7 x  M# ]: Y& [& N
$ j  |7 o! }, y# Z2 v9 e5 u, P

% u; o+ t% M- G
/ P$ A2 e8 R  t场景2：已知管理汇总表A，要根据一定的规则（如密接1、2、4、7，次密接1、7，浦东判的次密1、5、7，徐汇判的次密2、6、7，黄浦判的次密1、2、3、4、5、6、7，松江判的密接7，不要问我为什么管理口径这么五花八门且SB），筛选出部分对象，输出采样单B

; m* Q0 B% O9 w7 z首先我们设置了一个形如此的工作台：
; W+ u8 @8 Q9 U- K. T0 l( K# z
9 |* i, L; M, `! ^. w, x6 o! F从H4：P13范围分别设置目标管控类型，输出到哪张表，采样日期是管理开始的第几天
# [! s* |/ F4 u, C' b然后我们的汇总表是这样的（演示信息均非真实居民信息）：

# e5 I# G# R, h6 [7 S在工作簿中有一个隐藏的空采样单，调用生成采样单的脚本时会复制一份以便于粘贴信息，总的采样单生成脚本是这样的：
; ?; H7 U' I. @' n

1. Sub CreateRnaTestForm(Optional ByVal filename As String = "")
   
2. '
   
3. '根据当前Selection创建采样单，如选区为空则使用全部筛选项目创建
   : w* @2 u' w2 G  Y
4. '
   . u$ U* V& u! ]; A
5.     Application.StatusBar = "正在根据当前选区创建采样单"
   1 @3 T0 U4 o; e- N  J- Q
6.     Excel.Application.Calculation = xlCalculationManual
   
7. 
   
8. 
   : Z) @. e& f; y
9.     Sheets("纳管汇总表").Activate
   % \: y& {" `1 O# e0 |
10.     SelectAll = False
    
11.     If Selection Is Nothing Then
    
12.         SelectAll = True
    
13.     Else
    
14.         Set CCloumn = Range("C:C")
    . Q# Z9 P4 l9 t$ ?4 w- P% j: J
15.         Set Rng = Application.Intersect(CCloumn, Selection)
    
16.         If Rng Is Nothing Then
    
17.             SelectAll = True
    8 B$ k+ _' s" J" M3 m
18.         ElseIf Not Rng.address = Selection.address Then
    
19.             SelectAll = True
    
20.         End If
    - \/ }/ d. ^# @0 y
21.     End If
    
22.    
    
23.     If SelectAll Then
    
24.         Range("C1").Select
    
25.         Range(Selection, Selection.End(xlDown)).SpecialCells(xlCellTypeVisible).Select
    8 d8 A: P% [3 Y3 @! E. V  w- h; x5 O
26.         If Selection.Count = 1 Then
    8 ~6 ~% `7 U/ q
27.             Application.StatusBar = "选区为空创建失败"
    
28.             Exit Sub
    
29.         End If
    + ~' {; l4 D# p
30.         Range("C1").Select
    8 i# i* P$ z4 I! `6 n
31.         Selection.Offset(1, 0).Select
    
32.         Range(Selection, Selection.End(xlDown)).SpecialCells(xlCellTypeVisible).Select
    * D" |: _. x: u4 X6 P
33.     End If
    ' y" M) s1 w' C
34. 
    
35.     ' 将目标选区存入变量
    
36.     Dim Collection  As Range '目标选区
    7 ^. f2 b1 L* ^$ i. p
37.     Dim NewTestForm As Workbook '采样单区
    
38.     Set Collection = Selection
    
39.     Set TotalWB = ActiveWorkbook
    # @  R% e) a$ ^4 y0 A
40.    
    ( G& k* {  V3 f9 [9 x9 Q$ h
41.     If filename <> "" Then
    * _/ V4 P; n5 S, x) K6 |* L
42.         For Each wb In Workbooks
    5 E# s' Y, U% k( Y" }" I( D0 B
43.             For Each sh In wb.Sheets
    - p3 Q. _0 E- [6 B0 Y& O
44.                 If sh.Name = filename Then
    
45.                     Set NewTestForm = wb
    ) a$ l! C9 J  p* @1 G3 E- n; @
46.                     wb.Activate
    
47.                 End If
    
48.             Next
    + t$ q4 Q' w  B% W4 T5 Z3 a% D9 _
49.         Next
    
50.     Else
    
51.         filename = "采样单"
    
52.     End If
    
53.    
    5 _1 O+ j8 T2 P0 A  F/ y" K
54.     If NewTestForm Is Nothing Then
    
55.         '复制一份空白采样单
      z+ a, D( o1 Q, s
56.         Sheets("采样单模板").Visible = True
    % X4 u' l2 i, ?8 A. u" V  k  T
57.         Sheets("采样单模板").Select
    + ~, [0 K$ @" Y" {% Z
58.         Sheets("采样单模板").Copy
    
59.         Sheets("采样单模板").Select
    1 r- }& r2 y. \
60.         Sheets("采样单模板").Name = filename
    
61.         Set NewTestForm = ActiveWorkbook
    / a: B, y" k* r' S8 K9 f3 x
62.     End If
    
63.    
    
64.    
    
65.     Application.StatusBar = "复制姓名列"
    
66.     Collection.Copy
    + f2 G# k$ z8 A" A
67.     Dim startCell As Range
    5 ]5 ]; s6 }* r, Q
68.     If Range("C1").End(xlDown).Row = 2 Then
    " A# ~. m' E+ B0 A. x
69.         If IsEmpty(Range("C1").End(xlDown)) Then
    
70.             Set startCell = Range("C1").End(xlDown)
    
71.         Else
    
72.             Set startCell = Range("C1").End(xlDown).Offset(1, 0)
    / V$ g, H. q& K7 J0 B
73.         End If
    
74.     Else
    
75.         Set startCell = Range("C1").End(xlDown).Offset(1, 0)
    
76.     End If
    : [: t( n8 D" ~  |0 S( ?& W- Q
77.     startCell.Select
    ( u  p3 s0 U6 S8 h3 W2 o
78.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
79.    
    & h- l3 k* y5 K+ |6 F( y
80.     Application.StatusBar = "复制地址列"
    ( N! s- ^3 x/ `6 i) K0 G5 n3 n
81.     Collection.Offset(0, 5).Copy
    ! s  i" Y( q( }4 L! u, j) L
82.     Sheets(filename).Select
      o# f. k; `/ p% L% l) A3 |
83.     startCell.Offset(0, 6).Select
    
84.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ) ]/ \! v) @& A. f
85.    
    
86.     Application.StatusBar = "复制联系方式列"
    4 B; P/ F' d: e
87.     Collection.Offset(0, 6).Copy
    ) p2 {- Y6 \+ i
88.     Sheets(filename).Select
    4 m/ z6 a; t# y
89.     startCell.Offset(0, 7).Select
    
90.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    / ~! h* F* j. K; E) ^" H8 _1 k
91.    
    
92.     Application.StatusBar = "复制身份证号列"
    . u; \( b/ I6 k" n5 O
93.     Collection.Offset(0, 3).Copy
    
94.     Sheets(filename).Select
    1 }7 ~$ v8 }& |# t7 Y/ r' U
95.     startCell.Offset(0, 3).Select
    
96.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
97.    
    0 B9 P& b. y" x: G
98.     Application.StatusBar = "复制管控类型列"
    * W$ @  d1 a" i7 S
99.     Collection.Offset(0, -1).Copy
    # v" {8 j8 P4 j
100.     Sheets(filename).Select
       M. Y0 y, p1 W  w+ p2 }4 b
101.     startCell.Offset(0, 4).Select
     
102.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     6 b+ D2 `% M7 Q& N& a
103.    
     
104.     Application.StatusBar = "复制隔离开始时间列"
     - C% r; g; x; r* j& o: ^  k$ q; ]
105.     Collection.Offset(0, 8).Copy
     
106.     Sheets(filename).Select
     
107.     startCell.Offset(0, 9).Select
     - T4 L# g8 C: ?3 {( G
108.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     
109.    
     
110.     Application.StatusBar = "复制社区居委列"
     8 V" r3 Q, o0 q+ V  \9 B4 i( k1 s
111.     Collection.Offset(0, 4).Copy
     
112.     Sheets(filename).Select
     
113.     startCell.Offset(0, 8).Select
     / u# A% z, R) N2 @2 s
114.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     
115. 
     + w9 m# Z  U% ~% N6 b
116.    
     6 e  ]! n; F+ A* q6 L$ ?( o( F
117.     TotalWB.Sheets("采样单模板").Visible = False
     * d/ q) p9 g0 p* N- D
118.     TotalWB.Sheets("纳管汇总表").Activate
     
119.     NewTestForm.Sheets(filename).Activate
     
120. 
     
121.     Excel.Application.Calculation = xlCalculationAutomatic
     
122.     Application.StatusBar = "创建采样单完毕"
     
123. End Sub
     . V# I8 q" k/ r
124. 
     
125. Private Sub CreateRnaTestPlanByManageType(calculatedDate)
     : c( p  @  e8 O; Y4 [4 y
126.     Application.StatusBar = "根据管理类型生成采样单"
     3 w7 \6 s# X6 b7 a
127.     Set plan = Range(Selection.Offset(0, 2), Selection.End(xlToRight))
     ) I9 ]$ Y3 F& w9 k0 s; Z+ A1 Y0 ]
128.    
     2 l: [0 t0 ]5 H% ~; a/ m* k9 U
129.     Dim filename As String
     
130.     Dim manageType As String
     
131.     Dim arrayForDate() As Variant
     
132.    
     3 g+ ?/ N" ^. x9 s0 k* K
133.    
     ) e- w5 t: |+ L# J
134.     filename = "【采样计划】" & (Selection.Offset(0, 1).Value) & Format(calculatedDate, "mmdd")
     1 g' O$ o" V( x% N! d
135.     manageType = Selection.Value
     
136.     '计算筛选器的纳管日期勾选
     
137.     Count = plan.Count * 2 - 1
     
138.     ReDim arrayForDate(Count)
     
139.     For i = 0 To plan.Count - 1
     
140.         arrayForDate(i * 2) = 2
     " [+ L* c9 e% U( |" k8 b6 _
141.         targetDate = calculatedDate + 1 - plan.Cells(i + 1).Value
     
142.         arrayForDate(i * 2 + 1) = targetDate
     ( }/ Q  u% Z6 a" i" V4 E
143.     Next
     
144.    
     
145.     Application.StatusBar = "根据管理类型和日期创建筛选"
     
146.     Excel.Application.Calculation = xlCalculationManual
     
147.     '重置筛选
     
148.     Sheets("纳管汇总表").Activate
     
149.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=1
     
150.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=2, Criteria1:=manageType
     5 V+ t" w( q: Y) P, k6 d% V
151.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=3
     
152.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=4
     
153.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=5
     4 A8 s7 j8 z' E! V7 Y
154.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=6
     + m1 A% B% U: N: D& q
155.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=7
     
156.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=8
     * T# L* X0 w1 w) _% P
157.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=9
     
158.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=10
     # b" F9 a) o. m
159.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=11, Operator:=xlFilterValues, Criteria2:=arrayForDate
     
160.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=12
     
161.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=13, Criteria1:="="
     
162.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=14
     
163.     ActiveSheet.ListObjects("表2").Range.AutoFilter Field:=15
     
164.     Excel.Application.Calculation = xlCalculationAutomatic
     
165.    
     
166.     Range("O1").Select
     0 V, _/ m* X; J* G/ H; |
167.     Call CreateRnaTestForm(filename)
     
168. End Sub
     4 c% b$ `; E! d3 O1 ?1 w
169. 
     
170. Sub CreateRnaTestPlanBySelectedManageType()
     6 d/ a  @" U# Z) ]
171.     Dim calculatedDate
     , |6 n/ S, Z+ h/ w
172.     Set magicSheet = ActiveSheet
     
173.     If IsDate(Range("M14").Text) Then
     
174.         calculatedDate = CDate(Range("M14").Text)
     8 o6 t" }+ ?3 J9 S4 l
175.         MsgBox "将要生成" & Range("M14").Text & "的采样计划"
     ; f) b3 z! I, r2 }
176.     Else
     ! F) F+ C( H" l% A( a* G, U
177.         MsgBox "M14单元格输入的内容无法转换为日期"
     
178.         Exit Sub
     7 J2 E( |! U1 T
179.     End If
     
180.    
     * ~  u2 X; n% G8 w6 l! k( D  X; l0 z
181.     Call CreateRnaTestPlanByManageType(calculatedDate)
     
182. End Sub
     
183. 
     
184. Sub CreateRnaTestPlayBySelectedDate()
     
185.     Dim calculatedDate
     
186.     Set magicSheet = ActiveSheet
     
187.     If IsDate(Range("M14").Text) Then
     
188.         MsgBox "将要生成" & Range("M14").Text & "的采样计划"
     ' X! ~: L! t! |  T2 T7 }# F
189.         calculatedDate = CDate(Range("M14").Text)
     
190.     Else
     & g% A" g9 {$ W# E5 C- N/ _
191.         MsgBox "M14单元格输入的内容无法转换为日期"
     - b9 k$ {; U. u% X
192.         Exit Sub
     
193.     End If
     8 b5 X1 p- s- t  l7 l) M/ O4 q9 T
194.    
     2 z7 D3 [) H. [3 k2 n7 h
195.     Set target = Range("H4", Range("H4").End(xlDown))
     
196.     For i = 1 To target.Count
     ) R6 j3 p9 Y6 F% y; W% y
197.         magicSheet.Activate
     
198.         target.Cells(i).Select
     
199.         CreateRnaTestPlanByManageType (calculatedDate)
     
200.     Next
     
201. End Sub
     ( I* Q, T! C2 k8 D! ^3 R4 ]1 y( B
202. 
     7 z) G, u( a9 m+ ]
203. Sub SetM14ToYesterday()
     " ^' ~% q9 H" n2 E6 N% L7 Z7 b
204.     Range("M14").Value = Date - 1
     " N% z, n1 D: D3 s" i3 I& d2 S
205. End Sub
     
206. 
     / r. w* y( P) b6 e2 p) {/ u
207. Sub SetM14ToToday()
     
208.     Range("M14").Value = Date
     8 M: v- d. v0 |' U1 ^+ |& Z: [9 Y
209. End Sub
     
210. 
     ! p0 t6 @1 n6 q9 _: M, V) U! G
211. Sub SetM14ToTomorrow()
     
212.     Range("M14").Value = Date + 1
     
213. End Sub

复制代码

2 D1 w5 g3 X% M% U* W根据上述代码，我们既可以先在M14单元格设置日期，然后点击生成特定的采样计划，又可以生成全部采样计划，也可以在纳管汇总表中选择特定的对象，生成特定人的采样单。

) x' n0 ~2 }1 N" s4 D尽管这些代码用于安排采样，但事实上转运、转单、派流调单，本质上都是大同小异的。


3. 关于没有编程经验，VBA该如何上手？
, |) P6 I# ~8 y! M1 f
首先，请克服远离舒适圈的恐惧感。不要将编写VBA联想为编程，想象它是SPSS或者SAS，把EXCEL工作簿和工作表想象成数据集，VBA是一种“特殊”的统计脚本，我们只是在做本专业的东西，并非编程。

0 x  z; Y& }  E$ y0 G" v其次，OFFICE套件内置宏录制功能，许多复杂的操作微软可以帮你自动生成VBA代码，我们只需要按照需求，对自动生成的代码进行Ctrl+CV，以及小修小补，绝大多数时候无需大动干戈。关于如何使用宏录制自动生成代码，可以参考如下教程：
“录制简单的宏”章节
% K* w! j* {5 s4 d% H' f( o4 Lhttps://www.w3cschool.cn/excelvba/excelvba-what.html
1 R# @) R3 Q( N1 n
4. 有哪些需要注意的？
Excel的数据类型非常灵活，允许单元格中存储各式各样的内容并可能导致错误，例如最常见的身份证号变成科学计数法数字，还有固定电话带区号的丢失起始字段的0，因此将单元格数据类型明确设置是一个好习惯（无论你是否使用VBA自动处理），建议使用Excel的表格功能（Ctrl+T，也叫超级表），可以降低筛选、排序、以及数据复制粘贴时出错的可能。

最后，特别强调，程序绝对不是万能的。VBA可以将我们从繁琐机械的报表中解放出来，但是我们依然需要监督VBA正确工作，务必在自动生成报表后追加人工抽查、质控。

9 k" i9 S$ K* T# k- K7 t/ ~+ o
" a- L! S: d6 ^7 l8 q/ P0 M===============23-3-5更新================
1 [# _( H& k5 W2 |- [9 J0 q进阶：使用ACCESS强化你的报表系统
+ v0 K9 N8 J; X* S
当管理的个案数目逐渐增多，EXCEL表格的性能会出现显著下降。依照个人经验，能感受到明显的卡顿在2000条（个案中部分条目依赖公式计算）或者20000条（纯表格）时，此时对表格进行排序、筛选、或者是批量修改均能感受到界面卡顿。性能问题是EXCEL为我们提供强大的灵活性的代价，关于提高性能，我主要有以下办法：
) p  `% R8 m" L
, f$ t. u) p; _9 M! l! S; m0 E

• 将公式的计算模式切换为手动，可以在个案行数在1000数量级且表格中多列依赖公式自动计算时明显改善性能，需要注意调整结束后重新计算数据，或者改回自动计算模式，否则会导致报表信息错误，或者坑害不知情的和你翻班的同事。
• 分表，我们经常会遇到报表中绝大多数个案已经结案，仅近期个案为活跃条目。因此，我们可以创建一份复制Sheet，其表格结构与台账完全一致，结案条目剪切到这个Sheet中，通过减少台账长度的方式改善性能。
• 等，事实上一些大企业处理excel报表时，每个动作计算10分钟都是经常发生的事，所以让工作的脚步放慢也没什么大不了的。
• 迁移数据到access上面，excel作为前端展示数据和导出报表（终极解决办法）
  8 l0 s$ X' a6 V  K

ACCESS是一种可靠的关系型数据库，如果你的大学计算机课程有讲过VisualFox（和英语政治体育一样是必修课，部分大学会讲VF，另一部分大学会讲VB），上手ACCESS是非常容易的事情。即使你的大学没有讲过这些，我们专业课的SPSS和SAS，对数据库数据表的操作也有简单的涉猎，其中SPSS的数据集，就是一个非常简单的数据表。事实上SPSS也支持链接关系型数据库，用SQL来管理你的统计数据。
2 ~$ b7 y) s: a! y1 h) t2 o( s- S
ACCESS的第一张表，和SPSS非常像，仅仅需要注意在数据库中表可以不止一张，每张表都有自己的主键，表之间可以通过主键-外键构建联系。
7 w8 j8 Z  |0 a. @! R例如，每个管理对象可能会有一堆随访记录（个案信息表-随访记录表，一对多关系）
每个责任医生可能会有很多个管理对象，或者一个医生可能会临时管理其他医生的管理对象（多对多关系）
4 h+ F; \2 }2 W6 d与EXCEL的力大砖飞相比，ACCESS，或者说关系型数据库，可以更高效准确的处理这些复杂的信息。
以下是ACCESS的概览信息
https://www.bootwiki.com/msaccess/msaccess-overview.html
* d# f7 h3 h) J9 s以及如何在ACCESS中使用VBA强化你的魔法
https://learn.microsoft.com/zh-cn/office/vba/api/overview/access
4 k3 ?% _( p7 v1 A  l# t/ O8 o除此之外，对于所有的关系型数据库，有一种通用的表达式，被称作SQL，非常强大，可以帮助你在几秒钟内完成传统上EXCEL可能你要处理几小时的工作
2 _' `" j5 R+ @# R/ o- \https://www.runoob.com/sql/sql-tutorial.html
在绝大多数关系型数据库中，SQL语法几乎都是通用的，仅部分细枝末节存在少量区别（就像是普通话和方言）
3 ?. t, d' ]& |# u4 Z: P5 dACCESS中你可以直接创建SQL语句（被称作查询），也可以在VBA中执行你的SQL语句。在ACCESS+VBA+SQL的辅助下，即使是百万行信息，非常复杂的处理，也只需要十几分钟。
4 m; f7 r& ]* q" o+ c) t: M- EACCESS中VBA操作数据表，可以通过直接执行SQL，也可以通过DAO接口：
https://learn.microsoft.com/zh-c ... ecordset-object-dao

===============占楼后续更新用2================

感谢楼主的分享

牛人，感谢分享

感谢分享，新年开好头

B站很多视频，可以学习哈

YAR 发表于 2023-1-26 18:10
; v; O& d& K' u0 T! RB站很多视频，可以学习哈

1 `% Q$ b! c9 |% y% w; ^, A5 V
/ @  \% w- ]" _* K. Z4 X/ |. I新年快乐

用python不好吗，一是下一步办公软件都要国产化，python是开源的编程语言，国产操作系统完全支持；二是可以实现功能很多，统计和办公自动化只是其中很小一部分，pandas、numpy、sklearn三个工具库就能搞定数据统计、数据分析、机器学习了；三是针对大规模数据有着巨大的优势，运行速度非常快，excel光打开文件估计就得很长时间；四是对比楼主贴出的代码，同样的功能pythonr 代码更加简单，更好阅读和理解，从0起步几天就可以学会；五是对数据库特别是用与大数据的hbase+spark、clickhouse 的连接更加方便；六是可以编写更复杂的程序，实现精精美的分析图表(pyecharts)，图文分析报告自动生成，让人可以从定期的重复工作中解放出来（如日报、月报、年报等）；七是可以打包为程序，上传服务器，按需求定期自动执行。
本地在三年的疫情防控中，数据清洗、数据比对、数据挖掘、大数据分析、监测预警、报告生成都是使用python完成的。