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