根据条件将二维表拆分为多个一维表

大家好,今天跟大家分享一个表格拆分案例,具体如下:

原表及需求:

根据条件将二维表拆分为多个一维表

需求:根据二维表按照SKU拆分为多个一维表

拆分示例:

1)一共10个SKU,需拆分为10个表,每个SKU一个表

2)每个SKU表包含几列信息:SKU,车系,车型,城市,车架号

3)每个SKU表的行数根据SKU与城市的交叉数据确定,例如SKU为116的车,拆分完毕后有19行,其中成都3行,重庆3行……长春3行,其他SKU表同理

拆分结果展示:

根据条件将二维表拆分为多个一维表

代码解析:

Sub 生成()

    '不提示消息框,因为删除表格时有提示,因此先关闭

    Application.DisplayAlerts = False

    '关闭屏幕刷新

    Application.ScreenUpdating = False

    '删除“二维表”以外的其他表格

    '遍历每一个工作表

    For Each na In ThisWorkbook.Sheets

        '如果工作表的名字不等于“二维表”即删除

        If na.Name <> "二维表" Then

            na.Delete

        End If

    Next

    '获取二维表的行数即列数

    MyRow = Sheets("二维表").Cells(Rows.Count, 1).End(xlUp).Row

    MyColumn = Sheets("二维表").Cells(1, Columns.Count).End(xlToRight).Column

    '根据SKU的个数增加表,并将表的名字命名为SKU

    '第一次增加的表在“二维表”后,后面的表格依次往后添加

    For i = 2 To MyRow

        If i = 2 Then

            Sheets.Add After:=Sheets("二维表")

            ActiveSheet.Name = Sheets("二维表").Cells(i, 1).Value

            Else:

            Sheets.Add After:=ActiveSheet

            ActiveSheet.Name = Sheets("二维表").Cells(i, 1).Value

        End If

        '设置表头

        ActiveSheet.Range("A1").Value = "序号"

        ActiveSheet.Range("b1").Value = "车系"

        ActiveSheet.Range("C1").Value = "车型"

        ActiveSheet.Range("D1").Value = "城市"

        ActiveSheet.Range("E1").Value = "车架号"

        '按城市循环(列循环)

        For j = 4 To MyColumn

            '当车辆数据不为0时,就按照实际数据增加行数

            If Sheets("二维表").Cells(i, j).Value <> 0 Then

                '取得城市与SKU的交叉数据,即车辆个数,定义为CarNum

                CarNum = Sheets("二维表").Cells(i, j).Value

                '取得城市名称

                city = Sheets("二维表").Cells(1, j).Value

                '取得当前表格的行数

                ActiveRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

                '根据车辆个数,在A列增加序号

                For y = 1 To CarNum

                    ActiveSheet.Range("A" & ActiveRow + y).Value = y

                Next

                '在BCDE列增加车辆信息,整列增加

                ActiveSheet.Range("B" & ActiveRow + 1 & ":B" & ActiveRow + CarNum).Value = Sheets("二维表").Cells(i, 2).Value

                ActiveSheet.Range("C" & ActiveRow + 1 & ":C" & ActiveRow + CarNum).Value = Sheets("二维表").Cells(i, 3).Value

                ActiveSheet.Range("D" & ActiveRow + 1 & ":D" & ActiveRow + CarNum).Value = Sheets("二维表").Cells(1, CarNum).Value

                ActiveSheet.Range("E" & ActiveRow + 1 & ":E" & ActiveRow + CarNum).Value = ""

            End If

        Next

        '自动适应列宽

        Cells.EntireColumn.AutoFit

    Next

    '文件另存

    ThisWorkbook.SaveAs ThisWorkbook.Path & "\明细表-" & Format(Now, "yymmdd") & ".xlsx", FileFormat:= _

        xlOpenXMLWorkbook, CreateBackup:=False

    '定位新建工作表到“二维表”页

    ActiveWorkbook.Sheets("二维表").Select

    '开启消息框提示及屏幕更新

    Application.DisplayAlerts = True

    Application.ScreenUpdating = False

End Sub

----------------------------------------

有QQ的小伙伴可以加群:930619156

还在为查找网上浩若繁星的代码发愁?快来识别以下二维码,关注VBA代码集锦,帮你总结注释高效实用代码。更有代码视频讲解及更多EXCEL讲解视频。


上一篇:Epplus c# to excel 的 入门学习(二) 2-1: 单元格的字体样式 、2-2 插入形状。


下一篇:pytest文档20-pytest-html报告优化(添加Description)