Excel总表同列不 同数据批量 拆分到不同表

2025-10-21 14:43:38

1、如下图:Excel同列不同数据拆分到不同sheet,注意里面有合并单元格。(百道知道问题)

Excel总表同列不 同数据批量 拆分到不同表

Excel总表同列不 同数据批量 拆分到不同表

Excel总表同列不 同数据批量 拆分到不同表

1、首先打开上例文件,如下图。

Excel总表同列不 同数据批量 拆分到不同表

2、然后按下快捷键ALT+F11打开VBA(宏)编辑界面,然后点菜单栏【插入】下拉中列表中点【模块(M)】如图。 

Excel总表同列不 同数据批量 拆分到不同表

3、然后插入了一个模块1,在代码框中复制如下代码:

Sub 总表拆分表()

    '2020-5-25 22:46:15

    Dim r As Long, i As Long, mb(), k As Long, m As String

    r = Range("a" & Rows.Count).End(xlUp).Row

    ReDim mb(r - 1, 3)

    k = 0

    For i = 2 To r

        If i = 2 Then

            k = k + 1

            mb(k, 1) = Range("a" & i).Value

            mb(k, 2) = i

        Else

            If mb(k, 1) <> Range("a" & i).Value Then

                k = k + 1

                mb(k, 1) = Range("a" & i).Value

                mb(k, 2) = i

                mb(k - 1, 3) = i - 1

            End If

        End If

    Next i

    mb(k, 3) = r

    m = ActiveSheet.Name

    ActiveSheet.Copy After:=ActiveSheet

    m1 = ActiveSheet.Name

    Rows("2:" & r).Delete

    For i = 1 To k

        Sheets(m1).Copy After:=Sheets(Sheets.Count)

        ActiveSheet.Name = mb(i, 1)

        Sheets(m).Rows(mb(i, 2) & ":" & mb(i, 3)).Copy

        Range("a2").Insert Shift:=xlDown

        Range("a2").Select

    Next i

    Application.DisplayAlerts = False

    Sheets(m1).Delete

End Sub

Excel总表同列不 同数据批量 拆分到不同表

4、以上操作动态过程如下:

Excel总表同列不 同数据批量 拆分到不同表

5、回到工作表窗口,然后运行【总表拆分表】宏(菜单栏中点【视图】中下列表中【宏】列表【查看宏(V)】打开宏对方框,选该宏名),生成各表,运行过程如下图。

Excel总表同列不 同数据批量 拆分到不同表

Excel总表同列不 同数据批量 拆分到不同表

Excel总表同列不 同数据批量 拆分到不同表

1、以上是客户名顺序不重复,如果是间隔重复用上面宏运行将会出现错误,无法完成,如下图。

Excel总表同列不 同数据批量 拆分到不同表

Excel总表同列不 同数据批量 拆分到不同表

Excel总表同列不 同数据批量 拆分到不同表

2、将上面代码修改下,在上面模块1框复制如下代码:

Sub 总表间隔重复拆分表()

    '2020-5-25 23:10:24

    Dim r As Long, i As Long, mb(), k As Long, m As String, sh As Worksheet, j As Long

    r = Range("a" & Rows.Count).End(xlUp).Row

    ReDim mb(r - 1, 3)

    k = 0

    For i = 2 To r

        If i = 2 Then

            k = k + 1

            mb(k, 1) = Range("a" & i).Value

            mb(k, 2) = i

        Else

            If mb(k, 1) <> Range("a" & i).Value Then

                k = k + 1

                mb(k, 1) = Range("a" & i).Value

                mb(k, 2) = i

                mb(k - 1, 3) = i - 1

            End If

        End If

    Next i

    mb(k, 3) = r

    m = ActiveSheet.Name

    ActiveSheet.Copy After:=ActiveSheet

    m1 = ActiveSheet.Name

    Rows("2:" & r).Delete

    For i = 1 To k

        j = 0

        For Each sh In ActiveWorkbook.Sheets

            If sh.Name = mb(i, 1) Then

               j = 1

               Exit For

            End If

        Next sh

        If j = 0 Then

            Sheets(m1).Copy After:=Sheets(Sheets.Count)

            ActiveSheet.Name = mb(i, 1)

            Sheets(m).Rows(mb(i, 2) & ":" & mb(i, 3)).Copy

            Range("a2").Insert Shift:=xlDown

            Range("a2").Select

        Else

            Sheets(mb(i, 1)).Select

            Sheets(m).Rows(mb(i, 2) & ":" & mb(i, 3)).Copy

            Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Insert Shift:=xlDown

            Range("a2").Select

        End If

    Next i

    Application.DisplayAlerts = False

    Sheets(m1).Delete

End Sub

Excel总表同列不 同数据批量 拆分到不同表

3、回到工作表窗口,菜单栏中点【视图】中下列表中【宏】列表【查看宏(V)】打开宏对方框,选宏名“总表间隔重复拆分表 ”点【执行】,生成结果。

Excel总表同列不 同数据批量 拆分到不同表

Excel总表同列不 同数据批量 拆分到不同表

Excel总表同列不 同数据批量 拆分到不同表

Excel总表同列不 同数据批量 拆分到不同表

4、如果觉得这篇经验帮到了您,请点击下方的 “投票点赞" 或者“收藏”支持我!还有疑问的话可以点击下方的 “我有疑问”,谢谢啦!

声明:本网站引用、摘录或转载内容仅供网站访问者交流或参考,不代表本站立场,如存在版权或非法内容,请联系站长删除,联系邮箱:site.kefu@qq.com。
猜你喜欢