拆分表操作

左侧为操作区域，所有操作都在这里进行。

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

本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请点击举报。