怎么提高向Excel中写数据的速度????

Question

从一个MsFlexGrid控件中读入数据到Excel,代码如下,但是速度太慢,600行24列要近10分钟,怎么才能提高速度?Private Sub Command3_Click()
    On Error GoTo errorCancel
    
    Dim filename As String
    CommonDialog1.CancelError = True
    CommonDialog1.Filter = "Excel file (*.xls)|*.xls|All file (*.*)|*.*"
    CommonDialog1.Flags = CommonDialog1.Flags + cdlOFNOverwritePrompt
    CommonDialog1.ShowSave
    filename = CommonDialog1.filename
    If filename = "" Then
        Exit Sub
    End If
    
    On Error GoTo error
    
    Dim excelObj As New Excel.Application
    Dim wkBook As New Excel.Workbook
    Dim wkSheet As New Excel.Worksheet
    
    excelObj.Visible = False
    Set wkBook = excelObj.Workbooks.Add()
    Set wkSheet = wkBook.Sheets(1)
    
    For i = 0 To MSFlexGrid1.Rows - 1
        For j = 0 To MSFlexGrid1.Cols - 1
            MSFlexGrid1.Row = i
            MSFlexGrid1.Col = j
            wkSheet.Range(["A1"]).Offset([i], [j]).NumberFormatLocal = "@"
            wkSheet.Range(["A1"]).Offset([i], [j]).Value = MSFlexGrid1.Text
        Next j
    Next i
    
    For i = 1 To MSFlexGrid1.Cols
        wkSheet.Columns(i).EntireColumn.AutoFit
    Next i
    
    excelObj.DisplayAlerts = False
    wkBook.SaveAs filename
    excelObj.DisplayAlerts = True
    wkBook.Close
    excelObj.Quit
    Set excelObj = Nothing
    
    MsgBox "Data save success!", vbOKOnly, "Tip"
    
    Exit Sub
errorCancel:
    Exit Sub
error:
    ShowError
End Sub

Answer 1

不要直接从grid控件中向EXCEL写
可以在查询时将数据写进一个二维数组
再从数组中向EXCEL写入
最好再加上一个进度条
这样从感觉上能好些.

Answer 2

'可以用CopyFromRecordset '*************************************************************************
Private Function ExportStuScr2Excel(strPackFile As String, rs As ADODB.Recordset) As Boolean
    
    ExportStuScr2Excel = False
    
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Set xlApp = CreateObject("Excel.Application")
        
    If Dir$(strPackFile) <> "" Then
        Kill strPackFile
    End If
    
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    
        xlSheet.cells(1, 1).Value = "名称"
        xlSheet.cells(1, 2).Value = "年级"
        xlSheet.cells(1, 3).Value = "班级"
        xlSheet.cells(1, 4).Value = "考号"    xlSheet.Range("A2").CopyFromRecordset rs
        
    xlBook.SaveAs Filename:=strPackFile
    xlApp.Quit
    ExportStuScr2Excel = True
    
ExitFunction:
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Exit Function
ErrHandler:
    GoTo ExitFunction
End Function

Answer 3

不要从grid直接把结果写入Excel,可以采取先取得结果集，然后再写入Excel.比如：
Sql=...........Sub analyse_branch_all(sql As String, sheet As String)
Dim rsQuery As ADODB.Recordset
Dim ex As Excel.Application
Dim exwbook As Excel.Workbook
Dim exsheet As Excel.Worksheet
Dim path As String
Dim rowcount As Integer
Dim seq As Integer
Dim rowsel As String
On Error GoTo a:
    path = App.path
    Set ex = CreateObject("excel.application")
    Set exwbook = ex.Workbooks().Open(path & "\*****.xls", , True)
    Set exsheet = exwbook.Worksheets(sheet)
    exsheet.Activate
    ex.Application.Visible = True
    ex.Parent.Windows(1).Visible = True
    exsheet.Range("C2") = Calendar1.Value
    exsheet.Range("E2") = Calendar2.Value
    rowcount = 3
    seq = 0
    Set rsQuery = g_Conn.Execute(sql)
    If Not rsQuery.EOF Then
    rsQuery.MoveFirst
        Do Until rsQuery.EOF
            rowcount = rowcount + 1
            rowsel = "A" & rowcount
            exsheet.Range(rowsel) = rsQuery!query1
            rowsel = "C" & rowcount
            exsheet.Range(rowsel) = rsQuery!Query2
            rowsel = "E" & rowcount
            exsheet.Range(rowsel) = rsQuery!query3
            rsQuery.MoveNext
        Loop
    rsQuery.Close
    End If
Set rsQuery = Nothing
a:
End Sub