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

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

原表及需求：

需求：根据二维表按照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

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