excel将一个工作表根据条件拆分成多个工作簿

Function FilePicker() As String'新建一个对话框对象
'MsoFileDialogType 可为以下 MsoFileDialogType 常量之一。
'msoFileDialogFilePicker  允许用户选择文件。
'msoFileDialogFolderPicker  允许用户选择一个文件夹
'msoFileDialogOpen  允许用户打开文件
'msoFileDialogSaveAsSet FileDialogObject = Application.FileDialog(msoFileDialogFolderPicker)'配置对话框
With FileDialogObject.title = "请选择文件".InitialFileName = "D:\".AllowMultiSelect = FalseEnd With'显示对话框
FileDialogObject.Show'获取选择对话框选择的文件
Set paths = FileDialogObject.SelectedItemsFilePicker = paths(1)End Function'拆分工作表 （选择拆分保存目录）
Sub CFGZB()Dim myRange As VariantDim myArrayDim titleRange As RangeDim title As StringDim columnNum As IntegerDim sheetName As StringDim savePath As StringDim fieldTypeName As StringsheetName = "Sheet1"savePath = FilePicker()If Len(savePath) = 0 ThensavePath = "D:/"End IfmyRange = Application.InputBox(prompt:="请选择标题行：", Type:=8)myArray = WorksheetFunction.Transpose(myRange)Set titleRange = Application.InputBox(prompt:="请选择拆分的表头，必须是第一行，且为一个单元格，如：“姓名”", Type:=8)title = titleRange.ValuecolumnNum = titleRange.ColumnApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseDim i&, Myr&, Arr, num&Dim d, k, fileNameFor i = Sheets.Count To 1 Step -1If Sheets(i).name <> sheetName ThenSheets(i).DeleteEnd IfNext iSet d = CreateObject("Scripting.Dictionary")Myr = Worksheets(sheetName).UsedRange.Rows.CountArr = Worksheets(sheetName).Range(Cells(2, columnNum), Cells(Myr, columnNum))For i = 1 To UBound(Arr)d(Arr(i, 1)) = ""Nextk = d.keysFor i = 0 To UBound(k)Set conn = CreateObject("adodb.connection")conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullNamefieldTypeName = TypeName(k(i))fileName = k(i)If fieldTypeName = "String" ThenSql = "select * from [" & sheetName & "$] where " & title & " = '" & k(i) & "'"ElseIf fieldTypeName = "Date" ThenSql = "select * from [" & sheetName & "$] where " & title & " = #" & k(i) & "# "fileName = Replace(fileName, "/", "-")fileName = Replace(fileName, "\", "-")ElseSql = "select * from [" & sheetName & "$] where " & title & " = " & k(i)End If'MsgBox (Sql)Dim Nowbook As WorkbookSet Nowbook = Workbooks.AddWith NowbookWith .Sheets(1).name = fileNameFor num = 1 To UBound(myArray).Cells(1, num) = myArray(num, 1)Next num.Range("A2").CopyFromRecordset conn.Execute(Sql)End WithEnd WithThisWorkbook.ActivateSheets(1).Cells.SelectSelection.CopyWorkbooks(Nowbook.name).ActivateActiveSheet.Cells.SelectSelection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=FalseApplication.CutCopyMode = FalseNowbook.SaveAs savePath & "\" & fileNameNowbook.Close TrueSet Nowbook = NothingNext iconn.CloseSet conn = NothingApplication.DisplayAlerts = TrueApplication.ScreenUpdating = True
End Sub

excel将一个工作表根据条件拆分成多个工作簿相关推荐

excel将一个工作表根据条件拆分成多个工作表图文教程
本例介绍在excel中如何将一个工作表根据条件拆分成多个工作表. 注意:很多朋友反映sheets(i).delete这句代码出错,要注意下面第一个步骤,要拆分的数据工作表名称为"数据源&qu ...
用python将一个excel工作表根据条件拆分成多个工作表（只用openpyxl库）
用python将一个excel工作表根据条件拆分成多个工作表(只用openpyxl库) 最近在学python,刚刚了解了openpyxl库,就想写点实用的功能.比如按某列值拆分工作表. 先放代码 fr ...
将工作表按条件拆分成多个工作表或者工作簿，包含快速拆分与精致拆分
将一个工作表按条件拆分成多个工作表或者拆分成工作簿,包含快速拆分与精致拆分. 精致拆分可以保留所有格式,速度慢一点. 可以将一个工作表拆分成多个工作表,也可以直接拆分成多个独立文件. 将工作表按条件拆 ...
excel将一个工作表根据条件拆分成多个工作表，并将多个工作表怎么拆分成独立表格
目录一.原始数据表如下(sheet页名称为:数据源),需要根据B列人员所属组织拆分成每个组织一个工作表. 二.进入VBE编辑页面三.插入一个新的模块. 四.在模块1窗口粘入如下代码 ,并保存五. ...
excel将一个工作表根据条件拆分成多个工作表
转载:https://jingyan.baidu.com/article/d7130635071d2313fdf47585.html 注意:很多朋友反映sheets(i).delete这句代码出错,要 ...
excel将一个工作表根据条件拆分成多个工作簿、工作表
出现运行错误'3706',可将连接方式,改用DSN连接:conn.Open "Dsn=Excel Files;DBQ=" & ThisWorkbook.FullName 分 ...
Excel把一个工作表根据条件拆分成多个工作表
Excel 2016 参考https://jingyan.baidu.com/article/d7130635071d2313fdf47585.html 有时候需要在一个工作簿中建立多个工作表,并且需 ...
python把工作簿拆分为工作表_excel将一个工作表根据条件拆分成多个工作表
如下图,粘贴下列代码在模块中: Sub CFGZB() Dim myRange As Variant Dim myArray Dim titleRange As Range Dim title As ...
excel将一个工作表根据条件拆分成多个sheet工作表
本例介绍在excel中如何将一个工作表根据条件拆分成多个工作表.注意:很多朋友反映sheets(i).delete这句代码出错,要注意下面第一个步骤,要拆分的数据工作表名称为"数据源&quo ...

excel将一个工作表根据条件拆分成多个工作簿

excel将一个工作表根据条件拆分成多个工作簿相关推荐

最新文章

热门文章