vb操作excel

Question

问题：现在Access数据库中有两张表TableA和TableBTableA中有记录如下:
字段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 

Answer 1

sf，不容易啊！
关于vb操作excel，csdn上有太多太多的例子了，自己找一下！当然了，如果有安装例子，也可以看看visdata，这个例子不错...

Answer 2

'部件添加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 SubmyErr:
    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

Answer 3

可以先在窗体上放一个msflexgrid预览数据,然后导入excel,因为excel里面的Merge方法用起来有点慢

Answer 4

字段1(Name) 字段2(Num) 
      A          3 
      A          4 
      B          6 
得到
      A          3      
      A          4      7(该单元格是和其上面一个单元格合并的结果) 
      B          6      6 
方法很简单, 不用VB吧,直接用VBA就可以了.
一,EXCEL获取外部数据,把access导入到excel;
二,执行下面的宏即可.

Answer 5

Sub Macro1()
'
' Macro1 Macro
' 由 flesu 录制: 2010-3-9
'
x = CInt(Cells(1, 2))
For i = 2 To 4 你实际行数+1
  If Cells(i, 1) = Cells(i - 1, 1) Then
    x = x + CInt(Cells(i, 2))
  Else
    Cells(i - 1, 3) = x
    x = CInt(Cells(i, 2))
  End If
  
Next
'
End Sub

Answer 6

http://topic.csdn.net/u/20100308/15/bca33a9a-8999-4a8a-8969-bb63b2e578f4.html
SQL 已经有了，只要将查询结果用 Excel 的 CopyFromRecordset 就能直接导出。

Answer 7

楼主可以考虑一下录制一个宏即可，很简单，现成的VB代码。录制宏之前只需要考虑一下怎么将Access转换为Excel文件即可。

Answer 8

Option ExplicitSub 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