在 VB.Net 中将大数据表快速导出到 Excel 电子表格

我这里有一个有趣的难题，如何快速（在 1 分钟内）将大型数据表（由 SQL 填充，35,000 行）导出到 Excel 电子表格中供用户使用。我有可以处理导出的代码，虽然代码本身没有任何“错误”，但导出整个文件需要 4 分钟，速度慢得令人发指（如果用户的 RAM 较少或运行的内存较多，有时会需要更长的时间）他们的系统）。遗憾的是，与使用我们的旧方法花费 10 多分钟相比，这已经有所改进。简而言之，在不使用第三方组件的情况下，是否可以做得更快？如果是这样，怎么办？我的代码如下，速度减慢发生在每行写入的消息框 6 和 7 之间。感谢大家抽出宝贵的时间来查看此内容：

    Private Sub btnTest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnJeffTest.Click
           Test(MySPtoExport)
    End Sub

Private Sub Test(ByVal SQL As String)
    'Declare variables used to execute the VUE Export stored procedure
    MsgBox("start stop watch")
    Dim ConnectionString As New SqlConnection(CType(ConfigurationManager.AppSettings("ConnString"), String))
    Dim cmdSP As New SqlClient.SqlCommand
    Dim MyParam As New SqlClient.SqlParameter
    Dim MyDataAdapter As New SqlClient.SqlDataAdapter
    Dim ExportDataSet As New DataTable
    Dim FilePath As String

    MsgBox("stop 1 - end of declare")

    Try

        ' open the connection
        ConnectionString.Open()

        ' Use the connection for this sql command
        cmdSP.Connection = ConnectionString

        'set this command as a stored procedure command
        cmdSP.CommandType = CommandType.StoredProcedure

        'get the stored procedure name and plug it in
        cmdSP.CommandText = SQL

        'Add the Start Date parameter if required
        Select Case StDt
            Case Nothing
                ' there's no parameter to add
            Case Is = 0
                ' there's no parameter to add
            Case Else
                'add the parameter name, it's direction and its value
                MyParam = cmdSP.Parameters.Add("@StartDate", SqlDbType.VarChar)
                MyParam.Direction = ParameterDirection.Input
                MyParam.Value = Me.txtStartDate.Text
        End Select
        MsgBox("stop 2 - sql ready")
        'Add the End Date parameter if required
        Select Case EdDt
            Case Nothing
                ' there's no parameter to add
            Case Is = 0
                ' there's no parameter to add
            Case Else
                'add the parameter name, it's direction and its value

                MyParam = cmdSP.Parameters.Add("@EndDate", SqlDbType.VarChar)
                MyParam.Direction = ParameterDirection.Input
                MyParam.Value = Me.txtEndDate.Text
        End Select

        'Add the single parameter 1 parameter if required
        Select Case SPar1
            Case Is = Nothing
                ' there's no parameter to add
            Case Is = ""
                ' there's no parameter to add
            Case Else
                'add the parameter name, it's direction and its value
                MyParam = cmdSP.Parameters.Add(SPar1, SqlDbType.VarChar)
                MyParam.Direction = ParameterDirection.Input
                MyParam.Value = Me.txtSingleReportCrt1.Text
        End Select

        'Add the single parameter 2 parameter if required
        Select Case Spar2
            Case Is = Nothing
                ' there's no parameter to add
            Case Is = ""
                ' there's no parameter to add
            Case Else
                'add the parameter name, it's direction and its value
                MyParam = cmdSP.Parameters.Add(Spar2, SqlDbType.VarChar)
                MyParam.Direction = ParameterDirection.Input
                MyParam.Value = Me.txtSingleReportCrt2.Text
        End Select

        MsgBox("stop 3 - params ready")

        'Prepare the data adapter with the selected command 
        MyDataAdapter.SelectCommand = cmdSP

        ' Set the accept changes during fill to false for the NYPDA export
        MyDataAdapter.AcceptChangesDuringFill = False

        'Fill the Dataset tables (Table 0 = Exam Eligibilities, Table 1  = Candidates Demographics)
        MyDataAdapter.Fill(ExportDataSet)

        'Close the connection
        ConnectionString.Close()

        'refresh the destination path in case they changed it
        SPDestination = txtPDFDestination.Text

        MsgBox("stop 4 - procedure ran, datatable filled")

        Select Case ExcelFile
            Case True

                FilePath = SPDestination & lblReportName.Text & ".xls"

                Dim _excel As New Microsoft.Office.Interop.Excel.Application
                Dim wBook As Microsoft.Office.Interop.Excel.Workbook
                Dim wSheet As Microsoft.Office.Interop.Excel.Worksheet

                wBook = _excel.Workbooks.Add()
                wSheet = wBook.ActiveSheet()

                Dim dt As System.Data.DataTable = ExportDataSet
                Dim dc As System.Data.DataColumn
                Dim dr As System.Data.DataRow
                Dim colIndex As Integer = 0
                Dim rowIndex As Integer = 0

                MsgBox("stop 5 - excel stuff declared")

                For Each dc In dt.Columns
                    colIndex = colIndex + 1
                    _excel.Cells(1, colIndex) = dc.ColumnName
                Next

                MsgBox("stop 6 - Header written")

                For Each dr In dt.Rows
                    rowIndex = rowIndex + 1
                    colIndex = 0
                    For Each dc In dt.Columns
                        colIndex = colIndex + 1
                        _excel.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName)
                    Next
                Next

                MsgBox("stop 7 - rows written")

                wSheet.Columns.AutoFit()

                MsgBox("stop 8 - autofit complete")

                Dim strFileName = SPDestination & lblReportName.Text & ".xls"

                If System.IO.File.Exists(strFileName) Then
                    System.IO.File.Delete(strFileName)
                End If

                MsgBox("stop 9 - file checked")

                wBook.SaveAs(strFileName)
                wBook.Close()
                _excel.Quit()
        End Select

        MsgBox("File " & lblReportName.Text & " Exported Successfully!")


        'Dispose of unneeded objects
        MyDataAdapter.Dispose()
        ExportDataSet.Dispose()
        StDt = Nothing
        EdDt = Nothing
        SPar1 = Nothing
        Spar2 = Nothing
        MyParam = Nothing
        cmdSP.Dispose()
        cmdSP = Nothing
        MyDataAdapter = Nothing
        ExportDataSet = Nothing

    Catch ex As Exception
        '  Something went terribly wrong.  Warn user.
        MessageBox.Show("Error: " & ex.Message, "Stored Procedure Running Process ", _
       MessageBoxButtons.OK, MessageBoxIcon.Error)

    Finally
        'close the connection in case is still open
        If Not ConnectionString.State = ConnectionState.Closed Then
            ConnectionString.Close()
            ConnectionString = Nothing
        End If

        ' reset the fields
        ResetFields()

    End Try
End Sub

尽管这个问题是几年前提出的，但我想我会添加我的解决方案，因为问题是在 VB 中提出的，而“最佳答案”是在 C# 中。该解决方案在配备 16GB RAM 的 i7 系统上可在 4 秒内写入 22,000 多行 (1.9MB)。

Imports Excel = Microsoft.Office.Interop.Excel

Public Class Main
    Private Sub btnExportToExcel(sender As Object, e As EventArgs) Handles btnExpToExcel.Click
        'Needed for the Excel Workbook/WorkSheet(s)
        Dim app As New Excel.Application
        Dim wb As Excel.Workbook = app.Workbooks.Add()
        Dim ws As Excel.Worksheet
        Dim strFN as String = "MyFileName.xlsx"    'must have ".xlsx" extension

        'Standard code for filling a DataTable from SQL Server
        Dim strSQL As String = "My SQL Statement for the DataTable"
        Dim conn As New SqlConnection With {.ConnectionString = "My Connection"}
        Dim MyTable As New DataTable
        Dim cmd As New SqlCommand(strSQL, conn)
        Dim da As New SqlDataAdapter(cmd)
        da.Fill(MyTable)

        'Add a sheet to the workbook and fill it with data from MyTable
        'You could create multiple tables and add additional sheets in a loop
        ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
        DataTableToExcel(MyTable, ws, strSym)

        wb.SaveAs(strFN)    'save and close the WorkBook
        wb.Close()

        MsgBox("Export complete.")
    End Sub

    Private Sub DataTableToExcel(dt As DataTable, ws As Excel.Worksheet, TabName As String)
        Dim arr(dt.Rows.Count, dt.Columns.Count) As Object
        Dim r As Int32, c As Int32
        'copy the datatable to an array
        For r = 0 To dt.Rows.Count - 1
            For c = 0 To dt.Columns.Count - 1
                arr(r, c) = dt.Rows(r).Item(c)
            Next
        Next

        ws.Name = TabName   'name the worksheet
        'add the column headers starting in A1
        c = 0
        For Each column As DataColumn In dt.Columns
            ws.Cells(1, c + 1) = column.ColumnName
            c += 1
        Next
        'add the data starting in cell A2
        ws.Range(ws.Cells(2, 1), ws.Cells(dt.Rows.Count, dt.Columns.Count)).Value = arr
    End Sub
End Class

希望能帮助到你。