如何把这两列数用程序送到excel电子表格里面？

Question

我是通过程序生成的数，假设有如下程序：Private Sub Form_click()
    Dim i As Integer
    Dim a(1 To 10) As Integer
    
    For i = 1 To 10
        a(i) = Rnd * 10
    Next i
End Sub以i的值为第一列，a（i)的值为第二列，怎么编程存进EXCEl里谢谢大侠们！

Answer 1

Visual Basic 导出到 Excel 提速之法    
Excel 是一个非常优秀的报表制作软件，用VBA可以控制其生成优秀的报表，本文通过添加查询语句的方法，即用Excel中的获取外部数据的功能将数据很快地从一个查询语句中捕获到EXCEL中,比起往每个CELL里写数据的方法提高许多倍。将下文加入到一个模块中,屏幕中调用如下ExporToExcel("select * from table")则实现将其导出到EXCEL中Public Function ExporToExcel(strOpen As String)
'*********************************************************
'* 名称：ExporToExcel
'* 功能：导出数据到EXCEL
'* 用法：ExporToExcel(sql查询字符串)
'*********************************************************
Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer
    
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
    
    With Rs_Data
        If .State = adStateOpen Then
            .Close
        End If
        .ActiveConnection = Cn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Source = strOpen
        .Open
    End With
    With Rs_Data
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Function
        End If
        '记录总数
        Irowcount = .RecordCount
        '字段总数
        Icolcount = .Fields.Count
    End With
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
    xlApp.Visible = True
    
    '添加查询语句，导入EXCEL数据
    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
    
    With xlQuery
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
    
    xlQuery.FieldNames = True '显示字段名
    xlQuery.Refresh
    
    With xlSheet
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "黑体"
        '设标题为黑体字
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
        '标题字体加粗
        .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    
    With xlSheet.PageSetup
        .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称："   ' & Gsmc
        .CenterHeader = "&""楷体_GB2312,常规""公司人员情况表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期："
        .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位："
        .LeftFooter = "&""楷体_GB2312,常规""&10制表人："
        .CenterFooter = "&""楷体_GB2312,常规""&10制表日期："
        .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
    End With
    
    xlApp.Application.Visible = True
    Set xlApp = Nothing  '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = NothingEnd Function
注:须在程序中引用'Microsoft Excel 9.0 Object Library'和ADO对象,机器必装Excel 2000

Answer 2

可以参照这个例子（先取出了记录集）：
Private Sub PrintToExcel()
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing    Set xlBook = xlApp.Workbooks.Add(AppPath + "Bug.xls")
    Set xlSheet = xlBook.Worksheets(1)    With xlSheet
'        .Range(.Cells(1, 1), .Cells(1, DataGrid1.Columns.Count)).Merge
'        .Cells(1, 1) = "Bug清单"
'        .Cells(1, 1).Font.Size = 20
'        .Cells(1, 1).Font.Name = "宋体"
'        For i = 1 To DataGrid1.Columns.Count
'            .Cells(2, i) = DataGrid1.Columns(i - 1).Caption
'            .Cells(2, i).Font.Bold = True
'        Next        .Cells(2, 1) = "制表人：" + ModCnn.sUsername
        oRst.MoveFirst
        For i = 3 To oRst.RecordCount + 2
            For j = 1 To DataGrid1.Columns.Count ' oRst.Fields.Count
                .Cells(i + 1, j) = Trim(oRst.Fields(DataGrid1.Columns(j - 1).DataField)) '(j - 1)
            Next
            oRst.MoveNext
        Next
        .Cells(oRst.RecordCount + 4, 1) = "Bug总数：" + Trim(oRst.RecordCount)
        .Range(.Cells(3, 1), .Cells(oRst.RecordCount + 3, DataGrid1.Columns.Count)).Borders.LineStyle = 1
        .SaveAs AppPath + "Bug_" & Replace(Trim(Now), ":", ".") & ".xls"
    End With
    xlApp.Visible = TrueEnd Sub

Answer 3

Private Sub Command3_Click()
On Error GoTo err1
    Dim i As Long
    Dim j As Long
    Dim objExl As Excel.Application   '声明对象变量
    Me.MousePointer = 11            '改变鼠标样式
    Set objExl = New Excel.Application '初始化对象变量
    objExl.SheetsInNewWorkbook = 1  '将新建的工作薄数量设为1
    objExl.Workbooks.Add          '增加一个工作薄
    objExl.Sheets(1).Name = "book2"  '修改工作薄名称
    objExl.Sheets("book2").Select     '选中工作薄<book2>
    for i = 1 to 10
       objExl.Cells(i,1) = i
       objExl.Cells(i,2) = a(i)
    next
    objExl.Rows("1:1").Select         '选中第一行
    objExl.Selection.Font.Bold = True   '设为粗体
    objExl.Selection.Font.Size = 24     '设置字体大小
    objExl.Cells.EntireColumn.AutoFit  '自动调整列宽 
    objExl.ActiveWindow.SplitRow = 1  '拆分第一行
    objExl.ActiveWindow.FreezePanes = True   '固定拆分    objExl.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"  '设置打印固定行
objExl.ActiveSheet.PageSetup.PrintTitleColumns = ""    '打印标题    objExl.ActiveSheet.PageSetup.RightFooter = "打印时间: " & _
                   Format(Now, "yyyy年mm月dd日 hh:MM:ss")
    objExl.ActiveWindow.View = xlPageBreakPreview    '设置显示方式
    objExl.ActiveWindow.Zoom = 100                 '设置显示大小
objExl.ActiveSheet.Protect "123", DrawingObjects:=True,  _
Contents:=True, Scenarios:=True
    objExl.Application.IgnoreRemoteRequests = False
    objExl.Visible = True                       '使EXCEL可见
    objExl.Application.WindowState = xlMaximized 'EXCEL的显示方式为最大化
    objExl.ActiveWindow.WindowState = xlMaximized '工作薄显示方式为最大化
    objExl.SheetsInNewWorkbook = 3           '将默认新工作薄数量改回3个 
    Set objExl = Nothing    '清除对象
    Me.MousePointer = 0   '修改鼠标
Exit Sub
err1:
objExl.SheetsInNewWorkbook = 3
objExl.DisplayAlerts = False  '关闭时不提示保存
objExl.Quit                '关闭EXCEL
objExl.DisplayAlerts = True   '关闭时提示保存
Set objExl = Nothing
Me.MousePointer = 0
End Sub

Answer 4

我的引用是“Microsoft Excel 11.0 Object Library'”
这和程序运行不起来有没有关系呢？？Excel2003

Answer 5

To:xayzmb(行者) 我运行你的程序，单击按钮，没有看到有什么Excel出来啊？
我不太会，向你请教啊，谢谢

Answer 6

你的代码可以运行，没有错误提示窗口跳出，
但是看不到结果，excel的东西保存到哪里去了？

Answer 7

你注释掉这句:
On Error GoTo err1
再运行
会出错误提示

Answer 8

把代码简化一下
再运行看看:
Private Sub Command3_Click()
On Error GoTo err1
    Dim i As Long
    Dim objExl As Excel.Application   '声明对象变量
'在这里把你的代码加进去,你运行的时候是不是忘了下面的代码
'******************************************
Dim a(1 To 10) As Integer
    
    For i = 1 To 10
        a(i) = Rnd * 10
    Next i
'******************************************
    Me.MousePointer = 11            '改变鼠标样式
    Set objExl = New Excel.Application '初始化对象变量
    objExl.SheetsInNewWorkbook = 1  '将新建的工作薄数量设为1
    objExl.Workbooks.Add          '增加一个工作薄
    objExl.Sheets(1).Name = "book2"  '修改工作薄名称
    objExl.Sheets("book2").Select     '选中工作薄<book2>
    for i = 1 to 10
       objExl.Cells(i,1) = i
       objExl.Cells(i,2) = a(i)
    next
   
    objExl.Visible = True                       '使EXCEL可见
    objExl.Application.WindowState = xlMaximized 'EXCEL的显示方式为最大化
    objExl.ActiveWindow.WindowState = xlMaximized '工作薄显示方式为最大化
    objExl.SheetsInNewWorkbook = 3           '将默认新工作薄数量改回3个 
    Set objExl = Nothing    '清除对象
    Me.MousePointer = 0   '修改鼠标Exit Sub
err1:
objExl.SheetsInNewWorkbook = 3
objExl.DisplayAlerts = False  '关闭时不提示保存
objExl.Quit                '关闭EXCEL
objExl.DisplayAlerts = True   '关闭时提示保存
Set objExl = Nothing
Me.MousePointer = 0
End Sub