Excel VBA系列之for循环拆分数据至多张工作表

在如下的示例数据表中，分别把相应的数据拆分至以班级命名的多张工作表中。

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

以上示例只是用于演示，实际应用场景请根据自己的需要进行相应的设计或调整。

参考视频：Excel VBA系列之for循环拆分数据至多张工作表 - 知乎