|
Excel工作表拆分，如果方法掌握不得当，真的十分麻烦。 其实有很多办法实现，这里运用vba代码处理，一键式操作，方便快捷。  拆分表操作 左侧为操作区域，所有操作都在这里进行。 1、列表框 列表框里列出要以哪一列作为拆分条件，比如：本例以“部门”为拆分列，拆分后的表以各“部门”保存工作表。 2、导入工作表按钮 直接导入要拆分的工作表，这样就实现了任何表都可以在这里进行拆分。有一个小问题就是，拆分表第一行即是字段行，不要带标题，不然导入工作表后，列表框里无法选择拆分列。 导入对话框  导入对话框功能是十分必要的，从这里可以导入要进行拆分的工作表，通过文件选择框进行选择表，所以无论表在什么地方存储都可以实现拆分工作。 其主要有了文件对话框功能选择工作表 Application.FileDialog(msoFileDialogFilePicker) 3、开始拆分按钮 这个按钮就没什么可解释了，直接执行拆分工作，其后台有一些代码来运行，通常用户不需要知道都做了些什么，反正我们要个结果就行了。 拆分后的表 拆分后的工作表以同“部门”信息保存到一个表里，这样做就可以分发到各部门了。 如做考勤记录，工资管理，任务分配等，对部门分表的操作都可以实现。 当然，也可以按不同的列来进行拆分，如姓名，单位，单价，数量，型号等等，只要你想就可以实现。 VBA代码 代码比较凌乱，主要是一些条件逻辑可能比较多，也没有做过多的函数分解，所以统一在一个代码段里，显得可读性不是十分友好。 不过，为了追求结果，其它就不管了 ，因为也没想过再修改代码。 代码片段 Private Sub CommandButton2_Click()'''导入工作表Application.ScreenUpdating = FalseApplication.DisplayAlerts = FalseDim iRow As Integer, iCol As IntegerDim opW As WorkbookDim wkName As StringDim fobj As ObjectSet fobj = Application.FileDialog(msoFileDialogFilePicker)With fobj .Filters.Clear .AllowMultiSelect = False .Filters.Add 'Excel File', '*.xls,*.xlsx' .Filters.Add 'All File', '*.*' If fobj.Show = -1 Then Workbooks.Open (.SelectedItems(1)) Set opW = ActiveWorkbook ActiveSheet.UsedRange.Copy Me.Activate iRow = Me.Range('B65535').End(xlUp).Row iCol = Me.Range('ZZ2').End(xlToLeft).Column If iRow >= 2 Or iCol >= 2 Then Me.Range(Cells(2, 2), Cells(iRow, iCol)).Value = '' End If ''''''''''''''''''''''''''' Me.Range('B2').Select With Selection .PasteSpecial End With End IfEnd With '''''''''''''''' 添加列表框 iCol = Me.Range('ZZ2').End(xlToLeft).Column Me.OLEObjects('ListBox1').Object.Clear Dim i As Integer For i = 2 To iCol Me.OLEObjects('ListBox1').Object.AddItem Me.Cells(2, i).Value Next iIf Not opW Is Nothing Then opW.CloseApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub |
|
|
