常用代码

VBA常用代码（表格拆分&筛选）

前面说了表格合并,以下是表格拆分的常用代码，希望看后能举一反三，真正应用到实际工作中。
代码1
效果实现：筛选指定表格的指定列，并在同一个工作簿文件中创建不同的表（表名与所筛选的字段名相同），将每次筛选得到的数据结果复制到对应的表格中。
写代码之前先梳理一下做这个事情的思路，也就是咱们先“纸上谈兵”一下，然后再把纸上的自然语言翻译为VBA语言：
step1：先将源表拆分成多个表（拆分原则：拆分出来的表名与要筛选列的字段内容相同，且避免出现所建表的表名重复的问题出现）
step2：根据输入的需要筛选的列进行数据筛选
step3：将筛选得到的数据拷贝至对应表名的表中

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
Sub chaifen ()
Dim sht As Worksheet
Dim k, i, j As Integer
Dim irow As Integer '这个说的是一共多少行
Dim l
Dim str As String '用于提取当前工作表的名字
str = ActiveSheet.Name '取得当前要处理的表的名字
l = InputBox("请输入你要按哪列分")
'删除无意义的表
Application.DisplayAlerts = False '此语句作用是将警告框关闭（删除动作会弹出警告框）
If Sheets.Count > 1 Then    
    For Each sht1 In Sheets        
        If sht1.Name <> str Then '这里是第3处修改，不再用“数据”这个固定的名字了，而是用之前取到的名字           
            sht1.Delete        
        End If    
    Next
End If
Application.DisplayAlerts = True '此语句是将之前关闭的警告框重新设置为正常弹出
'获取待处理表格str的总行数
irow = Sheets(str).Range("a" & Rows.Count).End(xlUp).Row 
'拆分表'判断当前已有的表的名字是否和指定单元格名字一致，如果一致，则不重复创建同名表格（用K变量的值变化表示是否存在同名表）
For i = 2 To irow    
    k = 0    
    For Each sht In Sheets        
        If sht.Name = Sheets(str).Cells(i, l) Then          
            k = 1        
        End If    
    Next        
'如果不一致，即K=0，那么在现有表格的后面添加新表，同时将新表的名字修改为指定单元格的值    
    If k = 0 Then        
        Sheets.Add after:=Sheets(Sheets.Count) '新添加的表格都在原有表的后面        
        Sheets(Sheets.Count).Name = Sheets(str).Cells(i, l)  
    End If
Next
'根据输入的需要筛选的列进行数据筛选，并将筛选得到的数据拷贝至对应表名的表中   
For j = 2 To Sheets.Count'在源数据表中以指定j表名筛选第l列    
    Sheets(str).Range("a1:z" & irow).AutoFilter Field:=l, Criteria1:=Sheets(j).Name
'将上面筛选的结果拷贝到指定j表的a1单元格中    
    Sheets(str).Range("a1:z" & irow).Copy Sheets(j).Range("a1")
Next
'此语句用于去掉单元格的筛选
Sheets(str).Range("a1:z" & irow).AutoFilter   

'上述代码执行完成后，选择源数据表，使其为当前活动表
Sheets(str).Select   
MsgBox "已处理完毕"
End Sub

代码2
使用场景：以下代码实现的功能和上面的代码一样，只是代码是实现上稍稍简洁了一些，即原有的代码中仅定义了str是待处理的表格的名字，每次操作这个表的时候，都要用sheets(str),稍显啰嗦，而以下直接定义了变量sht0来指代待处理的表格，如此，就可以直接对sht0进行操作了。

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
Sub  chaifenupdate ()
Dim sht As Worksheet
Dim k, i, j As Integer
Dim irow As Integer '这个说的是一共多少行
Dim l As Integer
Dim sht0 As WorksheetSet 
sht0 = ActiveSheet 
'将对象赋值到变量，需要用
set l = InputBox("请输入你要按哪列分")
'1、删除无意义的表
Application.DisplayAlerts = False
If Sheets.Count > 1 Then    
    For Each sht1 In Sheets        
        If sht1.Name <> sht0.Name Then            
            sht1.Delete        
        End If    
    Next
End If
Application.DisplayAlerts = True
irow = sht0.Range("a65536").End(xlUp).Row
'2、拆分表
For i = 2 To irow    
    k = 0    
    For Each sht In Sheets        
        If sht.Name = sht0.Cells(i, l) Then            
            k = 1        
        End If    
    Next            
    If k = 0 Then        
    Sheets.Add after:=Sheets(Sheets.Count)        
    Sheets(Sheets.Count).Name = sht0.Cells(i, l)    
    End If
Next
'3、按照指定列进行筛选，并将筛选结果复制到对应表中
For j = 2 To Sheets.Count    
    sht0.Range("a1:z" & irow).AutoFilter Field:=l, Criteria1:=Sheets(j).Name    
    sht0.Range("a1:z" & irow).Copy Sheets(j).Range("a1")
Next
sht0.Range("a1:z" & irow).AutoFilter
sht0.Select
MsgBox "已处理完毕"
End Sub

通过表格拆分的代码实现过程，感受最为深刻的几个点是：
1、代码的编写不是一蹴而就的，好的代码一定是不断迭代优化更新的产物
2、开始写代码实现之前，不仅要先把实现的思路想清楚，还要“纸上谈兵”
3、将第2步纸上谈兵得出的做事步骤（SOP），用代码来实现
还有一个体会，或者说是屡试不爽的tips：如果涉及同样一个事需要做很多次的，就先把做一次，怎么做的代码写好，然后再装到For…Next循环中即可，当然，还需要将其中的固定值改为变量。
如今互联网如此发达的时代，对于编程而言，语法规则什么的，真的不是最重要的，关键是逻辑，说的直白一点，就是把想干的事儿想清楚。
知道怎么干了，编程只不过是将自然语言翻译一下罢了。