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

1、直接saveexcel行不行？

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

先写代码导出数据

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

无语，导出参考啊

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

方法一：

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

要设置样式，认认真真看

http://www.foxtable.com/webhelp/scr/2121.htm

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"
Dim idx As Integer = 0
For c As Integer = 0 To dt.Cols.Count -1 '添加列标题
    Dim c1 = ws.cells(1, c+1)
    Dim c2 = ws.cells(2, c+1)
    If dt.Cols(c).caption.contains("出入库") Then
        Dim Rg As MSExcel.Range = Ws.Range(c1.address & ":" & ws.cells(1, c+7).address)
        App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
        Rg.Merge  '合并指定区域的单元格
        c1.Value = dt.Cols(c).caption.split("_")(0)
        c2.Value = dt.Cols(c).caption.split("_")(1)
        If idx Mod 2 = 0
            c1.Interior.ColorIndex = 3'单元格填充颜色为红色
            c2.Interior.ColorIndex = 3'单元格填充颜色为红色
        End If
        idx += 1
    ElseIf dt.Cols(c).caption.contains("计") Then
        Dim Rg As MSExcel.Range = Ws.Range(c1.address & ":" & ws.cells(2, c+1).address)
        App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
        Rg.Merge  '合并指定区域的单元格
        c1.Value = dt.Cols(c).caption
        If idx Mod 2 = 0
            rg.Interior.ColorIndex = 3'单元格填充颜色为红色
        End If
        idx += 1
    Else
        Dim ary() = dt.Cols(c).caption.split("_")
        If ary.length = 1 Then
            Dim Rg As MSExcel.Range = Ws.Range(c1.address & ":" & c2.address)
            App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
            Rg.Merge  '合并指定区域的单元格
            c1.Value = ary(0)
        Else
            If idx Mod 2 = 1
                c2.Interior.ColorIndex = 3'单元格填充颜色为红色
            End If
            c2.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

看懂代码自己修改。看不懂，重新看vba教程

类似这样的代码。你要把地址你写成动态的（参考11楼）