主题：请教这复合表头，怎么用vba导出到excel表里

此主题相关图片如下：1.png

1、直接saveexcel行不行？

 

2、第一第二行，合并单元格就可以了啊（参考之前的帖子） http://www.foxtable.com/webhelp/scr/2121.htm

 

saveexcel不行，字段太多，右面怎么赋值不会，

先写代码导出数据

 

http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=28089&skin=0

 

然后，参考之前的代码，设置合并单元格

 

http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=119498&authorid=0&page=0&star=2

 

老师我没找到啊, 我是table控件数据导到excel不是表导入excel

无语，导出参考啊

 

http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=28089&skin=0

 

 

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:管理项目2.rar

看不太懂，请老师帮忙改一下，谢谢，一模一样的导出就可以

方法一：

 

Dim dt As Table = Tables("横向报表_Table1")
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.add
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
ws.name = "test"

For c As Integer = 0 To dt.Cols.Count -1 '添加列标题
    If dt.Cols(c).caption.contains("出入库") Then
        Dim Rg As MSExcel.Range = Ws.Range(ws.cells(1, c+1).address & ":" & ws.cells(1, c+7).address)
        App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
        Rg.Merge  '合并指定区域的单元格
        ws.cells(1, c+1).Value = dt.Cols(c).caption.split("_")(0)
        ws.cells(2, c+1).Value = dt.Cols(c).caption.split("_")(1)
    ElseIf dt.Cols(c).caption.contains("合计") Then
        Dim Rg As MSExcel.Range = Ws.Range(ws.cells(1, c+1).address & ":" & ws.cells(2, c+1).address)
        App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
        Rg.Merge  '合并指定区域的单元格
        ws.cells(1, c+1).Value = dt.Cols(c).caption
    Else
        Dim ary() = dt.Cols(c).caption.split("_")
        If ary.length = 1 Then
            Dim Rg As MSExcel.Range = Ws.Range(ws.cells(1, c+1).address & ":" & ws.cells(2, c+1).address)
            App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
            Rg.Merge  '合并指定区域的单元格
            ws.cells(1, c+1).Value = dt.Cols(c).caption
            ws.cells(1, c+1).Value = ary(0)
        Else
            ws.cells(2, c+1).Value = ary(1)
        End If
    End If
Next
For r As Integer = 0 To dt.Rows.Count - 1 '填入数据
    For c As Integer = 0 To dt.Cols.Count -1
        ws.cells(r+3, c+1).Value = dt.rows(r)(c)
    Next
Next

app.visible = True

方法二：

 

Dim dt As Table = Tables("横向报表_Table1")
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.add
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
ws.name = "test"

For c As Integer = 0 To dt.Cols.Count -1 '添加列标题
    If dt.Cols(c).caption.contains("出入库") Then
        Dim Rg As MSExcel.Range = Ws.Range(ws.cells(1, c+1).address & ":" & ws.cells(1, c+7).address)
        App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
        Rg.Merge  '合并指定区域的单元格
        ws.cells(1, c+1).Value = dt.Cols(c).caption.split("_")(0)
        ws.cells(2, c+1).Value = dt.Cols(c).caption.split("_")(1)
    ElseIf dt.Cols(c).caption.contains("合计") Then
        Dim Rg As MSExcel.Range = Ws.Range(ws.cells(1, c+1).address & ":" & ws.cells(2, c+1).address)
        App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
        Rg.Merge  '合并指定区域的单元格
        ws.cells(1, c+1).Value = dt.Cols(c).caption
    Else
        Dim ary() = dt.Cols(c).caption.split("_")
        If ary.length = 1 Then
            Dim Rg As MSExcel.Range = Ws.Range(ws.cells(1, c+1).address & ":" & ws.cells(2, c+1).address)
            App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
            Rg.Merge  '合并指定区域的单元格
            ws.cells(1, c+1).Value = dt.Cols(c).caption
            ws.cells(1, c+1).Value = ary(0)
        Else
            ws.cells(2, c+1).Value = ary(1)
        End If
    End If
Next
Dim arr(0 To dt.Rows.count-1,0 To dt.Cols.count-1) As Object  '定义二维数组
For r As Integer = 0 To dt.Rows.Count - 1 '填入数据
    For c As Integer = 0 To dt.Cols.Count -1
        arr(r, c) = dt.rows(r)(c)
    Next
Next
Dim Rg2 As MSExcel.Range = Ws.Range("A3:" & ws.cells(dt.Rows.count+2, dt.Cols.count).address)  '定义Excel中写入的区域
Rg2.Value = arr
app.visible = True

 

感谢老师的回复，非常成功！想把excel表，产品名称整个一个合并列，交替加上背景色，应该怎么加？