1. 在如图的一张工作表中,有多个班级的数据混合在一起,要求按照班级分别新建一班级名称命名的工作表,并将其对应的数据拆分至各个工作表中。
2. 打开Visual Basic,添加模块和过程,称之为“建表拆数据”。
Sub 建表拆数据()
End Sub
3. 添加新建工作表的代码,详细的步骤可以参考以下文章,这里将代码根据本案例的需求修改了一下。
Sub 建表拆数据()
Dim sht As Worksheet
Dim i, j As Integer
'建表
For j = 2 To Sheet1.Range("A10000").End(xlUp).Row
i = 0
For Each sht In Sheets
If sht.Name = Sheet1.Range("B" & j) Then
i = 1
End If
Next
If i = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Range("B" & j)
End If
Next
End Sub
4. 进一步对上面的这段代码进行可读性完善,可以定义一个变量krow为整数,且krow=Sheet1.Range("A10000").End(xlUp).Row,也就是数据总共的行数。
Sub 建表拆数据()
Dim sht As Worksheet
Dim i, j As Integer
Dim krow As Integer '此为数据总行数
'建表
krow = Sheet1.Range("A10000").End(xlUp).Row
For j = 2 To krow
i = 0
For Each sht In Sheets
If sht.Name = Sheet1.Range("B" & j) Then
i = 1
End If
Next
If i = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Range("B" & j)
End If
Next
End Sub
5. 添加筛选拆分数据的代码,详细的步骤可以参考以下文章,这里将代码根据本案例的需求修改了一下。
Excel VBA系列之利用筛选拆分数据至多张工作表 - 简书
Sub 建表拆数据()
Dim sht As Worksheet
Dim i, j, k As Integer
Dim krow As Integer '此为数据总行数
'建表
krow = Sheet1.Range("A10000").End(xlUp).Row
For j = 2 To krow
i = 0
For Each sht In Sheets
If sht.Name = Sheet1.Range("B" & j) Then
i = 1
End If
Next
If i = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Range("B" & j)
End If
Next
'拆分数据
For k = 2 To Sheets.Count
Sheet1.Range("A1:F" & krow).AutoFilter Field:=2, Criteria1:=Sheets(k).Name
Sheet1.Range("A1:F" & krow).Copy Sheets(k).Range("A1")
Next
Sheet1.Range("A1:F" & krow).AutoFilter
End Sub
6. 最后执行以上完整代码后,即可完成新建表和拆分数据的同步操作。
以上示例只是用于演示,实际应用场景请根据自己的需要进行相应的设计或调整。