以文本方式查看主题

-  Foxtable(狐表)  (http://www.foxtable.com/bbs/index.asp)
--  专家坐堂  (http://www.foxtable.com/bbs/list.asp?boardid=2)
----  求助！根据列内容相同与否将数据导出到同一个excel的不同sheet里  (http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=81808)
--  作者：jpg7
--  发布时间：2016/3/6 21:41:00
--  求助！根据列内容相同与否将数据导出到同一个excel的不同sheet里
第一列，中有内容A，b，C，D...；将第一列为A的导出到excel文件（分组数据）的sheetA中，将第一列为B的导出到excel文件（分组数据）的sheetB中......
--  作者：大红袍
--  发布时间：2016/3/6 22:34:00
--  

筛选后saveExcel即可，如

 

Tables("表A").Filter = "第二列 = \'1\'"
Tables("表A").SaveExcel("d:\\test.xls", "aA")
Tables("表A").Filter = "第二列 = \'2\'"
Tables("表A").SaveExcel("d:\\test.xls", "aB")
--  作者：wyz20130512
--  发布时间：2016/3/7 9:25:00
--  
对2楼的整理

With Tables("表A")
    Dim dyl_L As List(Of String) = .DataTable.Getvalues("第一列")
    For Each dyl_ As String In dyl_L
        .Filter = "第一列 = \'" & dyl_ & "\'"
        .SaveExcel("d:\\test.xls",dyl_)
    Next
End With
--  作者：jpg7
--  发布时间：2016/3/7 15:25:00
--  
谢谢
--  作者：wyz20130512
--  发布时间：2016/3/7 23:37:00
--  
可以封装为一个函数，如下：

\'根据列内容相同与否将数据导出到同一个excel的不同sheet里
Dim dlg As New SaveFileDialog
dlg.Filter = "Excel文件|*.xls"
If dlg.ShowDialog = DialogResult.OK Then
    With Tables(Args(0)) \'第一个参数为"表名"       
        Dim dyl_L As List(Of String) = .DataTable.Getvalues(Args(1)) \'第二个参数为"列名"
        For Each dyl_ As String In dyl_L
            .Filter = Args(1) & " = \'" & dyl_ & "\'"
            .SaveExcel(dlg.FileName,dyl_)
        Next
    End With
End If

以上为函数代码，其名称为：TableSaveSheetOfExcel

调用代码：Functions.Execute("TableSaveSheetOfExcel","表名","列名")
--  作者：jpg7
--  发布时间：2016/3/8 15:26:00
--  
如果是基于excel模板呢，而不是直接导出
--  作者：wyz20130512
--  发布时间：2016/3/8 15:35:00
--  
直接修改Execl模板中的打印条件即可。
--  作者：大红袍
--  发布时间：2016/3/8 15:40:00
--  

参考代码，思路是，生成各个的excel报表以后，合并到一个总报表里去。

 

Dim nams As List(Of String)
nams = DataTables("进度").GetValues("模号")


Dim App As New MSExcel.Application
Dim bname As String = ProjectPath & "开单\\总报表.xls"
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Add
Wb.WorkSheets(3).delete
Wb.WorkSheets(2).delete
Dim ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
For Each nam As String In nams
    If nam <> "" Then \'----姓名不是空
        Dim Book As New XLS.Book ( ProjectPath & "工作集群\\test.xls" )
        Dim sheet As XLS.Sheet = Book.Sheets(0)
        Tables("进度").filter = "模号 = \'" & nam & "\'"

        Book.Build()
        Dim fl As String = ProjectPath & "开单\\" & nam & ".xls"
        Book.Save(fl) \'保存工作簿
       
        Dim Wb_temp As MSExcel.WorkBook = App.WorkBooks.Open(fl)
        Dim Ws_temp As MSExcel.WorkSheet = wb_temp.WorkSheets(1)
        Ws_temp.name = nam
        Ws_temp.Copy(System.Reflection.Missing.Value, ws)
        wb_temp.close(False, System.Reflection.Missing.Value, System.Reflection.Missing.Value)
    End If
Next
ws.delete
Wb.saveas(bname)
App.Quit


Dim Proc As New Process \'打开工作簿
Proc.File = bname
Proc.Start()
--  作者：方丈
--  发布时间：2016/12/6 17:57:00
--  
 记号
--  作者：syjylyq
--  发布时间：2018/5/2 9:08:00
--  
MARK