excel表怎么增加列 c++_Excel通用总表按指定列一键分发工作表

上篇说了EXCEL一键汇总汇总多个工作表，今天来个逆过程，总表按指定列一键分发工作表。

这次是在上篇的基础上进行设置。

首先还是先看效果：

然后是快捷键设置：

TXT文档里面的是VBA代码

代码如下：

Sub 总表__工作表()

Dim wb1, wb As Workbook

Dim p As String

Dim d As Object

Dim a, b, i As Integer

Dim key, e

Set wb1 = ActiveWorkbook

Set d = CreateObject("scripting.dictionary")

'指定要保存的文件夹

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = ActiveWorkbook.Path

.Title = "请指定要保存的文件夹"

If .Show = -1 Then

p = .SelectedItems(1)

Else

Exit Sub

End If

End With

'将指定列的值填充字典进行去重

b = Val(InputBox("请输入表头行数"))

If b = 0 Then

Exit Sub

End If

a = Val(InputBox("请输入要拆分表的列数"))

Application.ScreenUpdating = False

If a = 0 Then

Exit Sub

End If

e = Timer

irow = Sheets(1).Range("A65536").End(xlUp).Row

For i = b + 1 To irow

d(Sheets(1).Cells(i, a).Value) = d(Sheets(1).Cells(i, a).Value) + 1

Next

'新建工作表并分发数据，以字典关键字命名

arr = d.keys()

If wb1.Sheets(1).AutoFilterMode = True Then

wb1.Sheets(1).Range("a" & b & ":z" & irow).AutoFilter '判断是否刷选，如果是则取消刷选

End If

For Each key In arr

wb1.Sheets(1).Range("a" & b & ":z" & irow).AutoFilter field:=a, Criteria1:=key

Set wb = Workbooks.Add

wb1.Sheets(1).Range("a1:z" & irow).Copy

wb.Sheets(1).Range("a1:z" & irow).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False '复制列宽

wb1.Sheets(1).Range("a1:z" & irow).Copy wb.Sheets(1).Range("a1")

wb.SaveAs p & "" & key & ".xlsx"

wb.Close

wb1.Sheets(1).Range("a" & b & ":z" & irow).AutoFilter

Next

MsgBox "分发完毕，用时" & Timer - e & "秒。"

Application.ScreenUpdating = True

End Sub

有几个要注意的地方：

1、运行的时候会要求输入表头行数和指定分发列，必须输入数字。2、分发的工作表的格式，列宽可以同步分发，行高不行。

下次说从总表分发到工作簿。