筛选非空的单元格，然后输出为单独的EXCEL文件，感谢大神

prc3

lsc900707 发表于 2017-2-21 19:27
试试这个吧，代码放sheet1工作表代码区，按钮用控件按钮运行：
Private Sub CommandButton1_Click()
   ...

大哥，我看了下，你的方法是先在原本的表格中拆分工资表，再执行导出，请问能不能直接导出呢，我的原表数据较大，如果先增加，再导出，那么我还要一个个的删除原表中增加的工资表，谢谢了

lsc900707

你的意思是筛选非零值先另存，拆不拆分再说?

prc3

lsc900707 发表于 2017-2-22 10:11
你的意思是筛选非零值先另存，拆不拆分再说?

不是的    我的意思是同步进行   不进行拆分这个步骤
代码是先拆分，保存后，然后再用另外的代码导出，

能不能这样，满足条件的数据直接就导出到外面的表格中

prc3

实在不行我在后面加了一个删除的，也能解决问题，不知道直接导出和先拆分哪个效率高：

     For Each sh In Worksheets
         If sh.Name <> "Sheet1" Then sh.Delete
     Next

lsc900707

我被你绕晕了，你能不能做个示例文件?

prc3

已经上传附件，谢谢

其他都对，但还有几个问题
1、渝中没有被成功的提取出来
2、运行代码后会在该表中自动添加上拆分表格，能不能本表格 不再保留拆分的表格直接导出，当然不方便的话我加了删除代码后也可以搞定，不知哪个效率高
也可以查看代码您就明白了，谢谢

求助.rar (43.88 KB, 下载次数: 14)

2017-2-22 11:23 上传

点击文件名下载附件

lsc900707

下午或晚上帮你再改改，这不难的。只是上班时间不方便。

lsc900707

prc3 发表于 2017-2-22 11:24
已经上传附件，谢谢

其他都对，但还有几个问题

代码已更改，请再测试效果吧：
Private Sub CommandButton1_Click()
     Dim tim1 As Date, tim2 As Date: tim1 = Timer
     Dim arr, d As Object, sh As Worksheet
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     Set d = CreateObject("scripting.dictionary")
     arr = Range("a1:c" & Cells(Rows.Count, 1).End(xlUp).Row)
     For i = 2 To UBound(arr)
         If Cells(i, 2) <> "" Then
             If Not d.exists(arr(i, 1)) Then
                 Set d(arr(i, 1)) = Range("a" & i).Resize(1, 3)
             Else
                 Set d(arr(i, 1)) = Union(d(arr(i, 1)), Range("a" & i).Resize(1, 3))
             End If
         End If
     Next
     x = d.keys
     For k = 0 To UBound(x)
         Set sh = ActiveWorkbook.Sheets.Add(, after:=ActiveSheet)
         sh.Name = x(k)
         d.items()(k).Copy sh.Range("a" & 2)
         Rows("1:1").Copy sh.Range("a1")
         sh.Cells.EntireColumn.AutoFit
     Next
     For Each sh In Worksheets
         If sh.Name <> "Sheet1" Then
             m = m + 1
             If m = 1 Then sh.Select Else sh.Select False
         End If
     Next
     ActiveWindow.SelectedSheets.Move
     ActiveWorkbook.Close True, ThisWorkbook.Path & "\拆分后的表"
     Sheets("Sheet1").Select
     Application.ScreenUpdating = True
     tim2 = Timer
     MsgBox Format(tim2 - tim1, "拆分完成，共耗时：0.00秒"), 64, "时间统计"
End Sub