vb操作excel

[qqweird0001]

问题：

现在Access数据库中有两张表TableA和TableB

TableA中有记录如下:
字段1(Name) 字段2(Num)
A 3
A 4
B 6
... ...
对应TableB中有记录如下:
字段1(Name) 字段2(Num)
A 7(为表TableA中两个之和)
B 6

现在想将两个表导出

导出到Excel中如下效果
A 3
A 4 7(该单元格是和其上面一个单元格合并的结果)
B 6 6

[bcrun]

我怎么看楼主这个意思,好像TableB是冗余的啊

[Tiger_Zhao]

SELECT A.Name, A.Num, B.TotalNum
  FROM TableA A 
  LEFT JOIN (SELECT B1.Name, B1.Num As TotalNum, A1.MaxNum 
               FROM TableB B1,
                    (SELECT Name, Max(Num) As MaxNum
                       FROM TableA
                      GROUP BY Name
                    ) A1 WHERE B1.Name=A1.Name
            ) B  ON A.Name=B.Name
                AND A.Num=B.MaxNum
 ORDER BY A.Name, A.Num

[cqq_chen]

没有答案，人工帮顶...

[ACMAIN_CHM]

网上现成的例子很多了。

[liguicd]

百度、Google 回复内容太短了！

[贝隆]

顶～～～～～～～～～～～～～～～

[chinaboyzyq]

'部件添加ADODC控件（Microsoft ADO Data Control 6.0）

Private Sub Command1_Click()
    With Adodc1
         .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data " & _
               "Source=C:\Documents and Settings\Administrator\My Documents\db23.mdb;" & _
               "Persist Security Info=False"
         
        .CommandType = adCmdText
        .RecordSource = "SELECT Count(*) FROM tablea group by  name order by name"
        .Refresh
        Dim rNum As Long, iRnum() As Long, excel_app As Object
        
        If .Recordset.BOF And .Recordset.EOF Then
           MsgBox "tableA is empty"
           Exit Sub
        Else
           rNum = .Recordset.RecordCount
           ReDim iRnum(rNum - 1)
           Dim i As Long
           For i = 0 To rNum - 1
               iRnum(i) = Adodc1.Recordset.Fields(0)
               Adodc1.Recordset.MoveNext
           Next
        End If
        .RecordSource = "select a.name,a.num,b.num from tablea a inner join " & _
                        "tableb b on a.name=b.name order by a.name"
        .Refresh
         rNum = .Recordset.RecordCount
        Set excel_app = CreateObject("Excel.Application")
        'excel_app.Visible = True
        excel_app.WorkBooks.Add
        Screen.MousePointer = vbHourglass
        excel_app.Sheets("sheet1").Select
                
        Dim iiRow As Long, iiCol As Integer, iRow As Long
        iiRow = 1: iiCol = 0
        Do While Not .Recordset.EOF
            Do While iiCol <= .Recordset.Fields.Count - 1
                excel_app.Cells(iiRow, 1 + iiCol) = .Recordset.Fields(iiCol)
                iiCol = iiCol + 1
                DoEvents
            Loop
            iiCol = 0
            iiRow = iiRow + 1
            .Recordset.MoveNext
            DoEvents
        Loop: .Recordset.Close
        excel_app.DisplayAlerts = False
        iRow = 1
        For iiRow = 0 To UBound(iRnum)
            excel_app.ActiveSheet.Range("c" & iRow, "c" & (iRow + iRnum(iiRow) - 1)).Merge
            iRow = iRow + iRnum(iiRow)
        Next
        '存盘文件C:\12345
        If Not excel_app.ActiveWorkBook.Saved Then
            excel_app.ActiveWorkBook.SaveAs FileName:="c:\12345"
        End If
        excel_app.DisplayAlerts = True
        excel_app.Quit
        Set excel_app = Nothing
        Screen.MousePointer = vbDefault
        MsgBox "OK C:\12345.xls"
    End With
    Exit Sub

myErr:
    If Err.Number = 429 Then
        Screen.MousePointer = vbDefault
        MsgBox "请先安装EXCEL!", , "导出错误"
        Exit Sub
    End If
    excel_app.DisplayAlerts = False
    excel_app.Quit
    excel_app.DisplayAlerts = True
    Set excel_app = Nothing
    Me.MousePointer = 0
    MsgBox " 导出数据到 Excel 时出错! ", , "导出错误"
End Sub

[Tiger_Zhao]

Option Explicit

Sub Main()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sql As String
    Dim xlApp As Excel.Application
    Dim xlWb As Excel.Workbook
    Dim xlWs As Excel.Worksheet
    
    sql = " SELECT A.Name, A.Num, B.TotalNum" & _
          "   FROM TableA A " & _
          "   LEFT JOIN (SELECT B1.Name, B1.Num As TotalNum, A1.MaxNum " & _
          "                FROM TableB B1," & _
          "                     (SELECT Name, Max(Num) As MaxNum" & _
          "                        FROM TableA" & _
          "                       GROUP BY Name" & _
          "                     ) A1 WHERE B1.Name=A1.Name" & _
          "             ) B  ON A.Name=B.Name" & _
          "                 AND A.Num=B.MaxNum" & _
          "  ORDER BY A.Name, A.Num"

    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=C:\db1.mdb;" & _
            "Persist Security Info=False"
    
    Set rs = cn.Execute(sql)
    
    Set xlApp = New Excel.Application
    Set xlWb = xlApp.Workbooks.Add()
    Set xlWs = xlWb.Worksheets(1)
    
    xlWs.Cells(1, 1).CopyFromRecordset rs
    
    xlWb.SaveAs "C:\output.xls"
    
    Set xlWs = Nothing
    xlWb.Close
    Set xlWb = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub