识别在编写SQL时需要改进VBA代码的区域

我正在寻找优化以下模块的方法。

我将经常需要用我在excel工作表/工作簿中收到的带有大型数据集的数据库来更新数据库。我已经制作了一个模块，可以将工作表导入到指定的数据库中。在这里使用stringbuilder类-

https://codereview.stackexchange.com/questions/196076/bringing-the-system-text-stringbuilder-up-to-lightning-speed-in-the-vba

据我测试，它适用于非常大的数据集并处理我遇到的所有异常（只要数字列中没有字符串），但我更担心性能。立即写入，它以大约650行/秒的速度写入sql服务器。还有其他机会以这种/提高速度转储内存吗？之所以必须这样做，是因为数据集越大，导入速度越低。我不确定这是否是服务器。

Main函数，遍历该行，然后迭代到下一个，构建格式化的插入sql语句。

Public Sub buildQuery()
        Dim sb As StringBuilder
        Set sb = New StringBuilder
        Dim queryText As String
        Application.ScreenUpdating = False
        lr = Cells(Rows.Count, 4).End(xlUp).row
        lc = Cells(1, Columns.Count).End(xlToLeft).column
        Dim MyTimer As Date
        MyTimer = Now
        Debug.Print MyTimer

    For i = 2 To lr

    Application.StatusBar = "Progress: " & i & " of " & lr & " : " & format(i / lr, "0%")

        If (i Mod 1000) = 0 Then
            sb.Append buildRow(currentCell, i, n, lc)
            queryText = intoStatement() + sb.ToString
            queryText = Left(queryText, Len(queryText) - 1)
            query (queryText)
            Set sb = Nothing
            queryText = Nothing
            Set sb = New StringBuilder
            i = i + 1
            End If

        sb.Append buildRow(currentCell, i, n, lc)
        sb.Append vbNewLine

    Next i

    queryText = intoStatement() + sb.ToString
    queryText = Left(queryText, Len(queryText) - 3)
    query (queryText)

MyTimer = Now
Debug.Print MyTimer
Application.ScreenUpdating = True
Application.StatusBar = False
End
End Sub

在工作表中导入了一些极低的值，导致我不得不处理服务器端的类型错误，所以我做到了这一点。它只是将负数四舍五入到小数点后十位。

Function smallNo(no As Variant)

If IsNumeric(no) Then
     If no < 0 Then
     smallNo = Round(no, 10)
     Else
     smallNo = no
     End If

End Function
这将生成并返回按SQL要求格式化的单行

Function buildRow(currentCell As Variant, i As Variant, n As Variant, lc As Variant) As String

Dim sb As StringBuilder
Set sb = New StringBuilder

      For n = 1 To lc
        currentCell = smallNo(Cells(i, n))

        Select Case True
            Case IsError(currentCell), IsEmpty(currentCell)
                If n = 1 Then
                sb.Append ("(NULL,")
                ElseIf n = lc Then
                sb.Append "NULL),"
                Else
                sb.Append "NULL,"
                End If
            Case Else
               cellString = Replace(CStr(currentCell), ("'"), "")
                If n = 1 Then
                    sb.Append "('" & cellString & "',"
                ElseIf n = lc Then
                    sb.Append "'" & cellString & "'), "
                Else
                sb.Append Chr(39) & cellString & "',"
                End If
        End Select
        Next n
        buildRow = sb.ToString
        Set sb = Nothing
End Function

从标头构建插入***值。假定标题与数据库表中的列名相同。理想情况下，电子表格中的标题列将是您导入之前唯一需要进行的编辑。

Public Function intoStatement() As String
With ActiveSheet
 lc = .Cells(1, .Columns.Count).End(xlToLeft).column
    Dim headerCells As Variant
    headerCells = .Range(.Cells(1, 1), .Cells(1, lc))
End With

Dim headers As String
headers = Join(Application.Transpose(Application.Transpose(headerCells)), ",")

intoStatement = "INSERT INTO " & _
"[tempdb].[dbo].testDB3 (" & headers & ") Values "

End Function

在这里我们打开到sql server的连接并执行生成的查询。执行此操作后，将转储stringbuilder对象queryText

Function query(sqlStr As String)

Dim connection As New ADODB.connection
Dim strSQL As New ADODB.Command
Dim connString As String

connection.Open "DRIVER={SQL Server};SERVER=DESKTOP;" & _
       "trusted_connection=yes;dsn=tw;DATABASE=tempdb"

strSQL.ActiveConnection = connection
strSQL.CommandText = sqlStr
strSQL.CommandType = adCmdText

strSQL.Execute

connection.Close


End Function