在如下的示例数据表中,分别把相应的数据拆分至以班级命名的多张工作表中。
1. 打开Visual Basic,添加模块或过程,称之为“拆分数据”。
Sub 拆分数据()
End Sub
2. 添加一个for循环,循环“班级”这列中的每个单元格,找到对应的班级。
Sub 拆分数据()
Dim i As Integer
For i = 2 To Sheet1.Range("B10000").End(xlUp).Row
Next
End Sub
3. 添加一个if判断,如果B列中单元格的班级名称信息与工作表名称相同,则将该单元格的整行数据复制到对应的工作表。
以“A班”为例:
Sub 拆分数据()
Dim i As Integer
For i = 2 To Sheet1.Range("B10000").End(xlUp).Row
If Sheet1.Range("B2") = Sheet2.Name Then
Sheet1.Range("B2").EntireRow.Copy Sheet2.Range("A2")
End If
Next
End Sub
4. 定义一个变量k,计算各班级工作表中已有数据的行数,用于将复制过来的数据粘贴至k+1这一空白行。
Sub 拆分数据()
Dim i As Integer
For i = 2 To Sheet1.Range("B10000").End(xlUp).Row
If Sheet1.Range("B2") = Sheet2.Name Then
k = Sheet2.Range("A10000").End(xlUp).Row
Sheet1.Range("B2").EntireRow.Copy Sheet2.Range("A2")
End If
Next
End Sub
5. 在if判断中更换变量i和k,先将A班的数据复制过来测试一下。
Sub 拆分数据()
Dim i, k As Integer
For i = 2 To Sheet1.Range("B10000").End(xlUp).Row
If Sheet1.Range("B" & i) = Sheets(2).Name Then
k = Sheets(2).Range("A10000").End(xlUp).Row
Sheet1.Range("B" & i).EntireRow.Copy Sheets(2).Range("A" & k + 1)
End If
Next
End Sub
6. 再定义一个变量j,把每张工作表都循环,套在之前的循环外面。
Sub 拆分数据()
Dim i, k, j As Integer
For j = 2 To Sheets.Count
For i = 2 To Sheet1.Range("B10000").End(xlUp).Row
If Sheet1.Range("B" & i) = Sheets(j).Name Then
k = Sheets(j).Range("A10000").End(xlUp).Row
Sheet1.Range("B" & i).EntireRow.Copy Sheets(j).Range("A" & k + 1)
End If
Next
Next
End Sub
7. 执行以上代码后,即可将数据分别粘贴到各班级的工作表中。
如果要清空各班级工作表的数据,可以通过下面的过程来实现:
Sub 清空数据()
Dim i As Integer
For i = 2 To Sheets.Count
Sheets(i).Range("A2:A10000").EntireRow.Delete
Next
End Sub
上面这个“清空数据”的过程可以添加至“拆分数据”的过程中,如图所示。
Sub 拆分数据()
Dim i, k, j As Integer
Call 清空数据
For j = 2 To Sheets.Count
For i = 2 To Sheet1.Range("B10000").End(xlUp).Row
If Sheet1.Range("B" & i) = Sheets(j).Name Then
k = Sheets(j).Range("A10000").End(xlUp).Row
Sheet1.Range("B" & i).EntireRow.Copy Sheets(j).Range("A" & k + 1)
End If
Next
Next
End Sub
以上示例只是用于演示,实际应用场景请根据自己的需要进行相应的设计或调整。