從 excel 中的列創建逗號分隔的字符串數組以在 VBA sql 查詢中使用

Question

我需要從 Sheet1 A 列（每天變化的行數 - 可以超過 7,000）和 Sheet2 B 列（也是動態的 - 每天都在變化）獲取值，將這些值從列中放入 STRING 類型的數組中（可以是兩個 arrays，只要我可以在查詢中使用它們）並在 vba 查詢中使用數組 WHERE... IN ('array') 在 MS-SQL 服務器中運行。

我嘗試了不同的方法將值放入數組中，但失敗了，因為當我需要 String 類型（在查詢中工作）時，提供的許多解決方案需要使用 Array AS Variant。 一種有效的方法是將值（逗號分隔）放入另一張表的一個單元格中，並在查詢中使用該 cell.value。 但該方法僅適用於總行數為 3000 或更少的行。 我嘗試添加更多 - 比如 cell2.value、cell3.value，但如果沒有可用於 cell3.value 的值，我會收到錯誤（例如）。 請幫忙。

Sub GetData()

Dim oConn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim fld As ADODB.Field
Dim mssql As String
Dim row As Integer
Dim Col As Integer
Dim WB As ThisWorkbook

'============THIS IS THE PART I NEED HELP WITH ======================
Dim strArray() As String    'TRYING TO GET VALUES FROM COLUMN AS ARRAY
Dim TotalRows As Long
Dim i As Long

TotalRows = Rows(Rows.count).End(xlUp).row
    ReDim strArray(1 To TotalRows)

    For i = 1 To TotalRows
        strArray(i) = Cells(i, 1).Value & "','"    'TRYING TO INCLUDE COMMAS BETWEEN VALUES
    Next
'===========================================================================  
        
Set WB = ThisWorkbook
Application.ScreenUpdating = False
Set oConn = New ADODB.Connection      'NEED TO CONNECT TO SQL SERVER TO RUN QUERY
Set rs = New ADODB.Recordset
mssql = "SELECT Order.ID, Order.OrderDate, Order.Account" _
        & " FROM dbo.tbl_Order" _
        & " WHERE Order.ID IN ('" & strArray() & "0'")"   '<=== THIS IS WHERE I NEED TO INSERT STRING ARRAY
        
        
    oConn.ConnectionString = "driver={SQL Server};" & _
    "server=SERVER01;authenticateduser = TRUE;database=DATABASE01"
            
    oConn.ConnectionTimeout = 30
        oConn.Open
rs.Open mssql, oConn
If rs.EOF Then
MsgBox "No matching records found."
rs.Close
oConn.Close
Exit Sub
End If

' ===clear data in columns in worksheet as new values are copied over old ones
' ===this part is working fine
Worksheets("Sheet3").Range("A:P").ClearContents

' START WRITING DATA TO SHEET3
row = 5
Col = 1

    For Each fld In rs.Fields
    Sheet3.Cells(row, Col).Value = fld.Name
    Col = Col + 1
    Next
    
rs.MoveFirst

row = row + 1

Do While Not rs.EOF

Col = 1
    
    For Each fld In rs.Fields
    Sheet1.Cells(row, Col).Value = fld
    Col = Col + 1
    Next
row = row + 1
rs.MoveNext
Loop

rs.Close

oConn.Close

End Sub

Answer 1

您不想構建一個數組，而是一個包含您需要的值的字符串。 我剝離了你的代碼來說明它是如何工作的：

Sub GetData()
   Dim values As String
   Dim mssql As String
   Dim TotalRows As Long
   Dim i As Long
   
   TotalRows = Rows(Rows.Count).End(xlUp).row

   For i = 1 To TotalRows
      values = values & "'" & Cells(i, 1).Value & "',"
   Next
   
   values = Mid(values, 1, Len(values) - 1)
   
   mssql = "SELECT Order.ID, Order.OrderDate, Order.Account " & _
           "FROM dbo.tbl_Order " & _
           "WHERE Order.ID IN (" & values & ")"

   MsgBox mssql
End Sub

Answer 2

從列中獲取從零開始

• 如果您可以使用字符串數組（不知道SQL ），對於A列，您可以使用：

   Dim strArray() As String: strArray = getZeroBasedFromColumn(Range("A2"))

• 如果你必須使用一個字符串，那么你將不得不這樣做：

   Dim strArray As String strArray = "'" & Join(getZeroBasedFromColumn(Range("A2")), "','") & "'"

  並使用不帶括號的strArray 。

• 適當地限定第一個單元格范圍（ A2 ），例如WB.Worksheets("Sheet1").Range("A2") 。

• 兩種解決方案都使用以下 function。

編碼

Function getZeroBasedFromColumn( _
    FirstCell As Range) _
As Variant
    Const ProcName As String = "getZeroBasedFromColumn"
    On Error GoTo clearError
    
    If Not FirstCell Is Nothing Then
        Dim rg As Range
        Set rg = FirstCell.Resize(FirstCell.Worksheet.Rows.Count - FirstCell.Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If Not rg Is Nothing Then
            Set rg = FirstCell.Resize(rg.Row - FirstCell.Row + 1)
            Dim rCount As Long: rCount = rg.Rows.Count
            Dim Data As Variant
            If rCount = 1 Then
                ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
            Else
                Data = rg.Value
            End If
            Dim arr() As String: ReDim arr(0 To rCount - 1)
            Dim i As Long
            For i = 1 To rCount
                arr(i - 1) = CStr(Data(i, 1))
            Next i
            getZeroBasedFromColumn = arr
        End If
    End If

ProcExit:
    Exit Function
clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume ProcExit
End Function

Sub getZeroBasedFromColumnTEST()
    Dim arr() As String: arr = getZeroBasedFromColumn(Range("A1"))
End Sub

Answer 3

另一種方法（如果您有必要的數據庫權限）是創建一個臨時表並使用 JOIN 代替 WHERE IN()。

Option Explicit

Sub GetData()
 
    ' get list of order numbers from Col A Sheet1 and COl B Sheet2
    Dim wb As Workbook, wsOut As Worksheet
    Dim rngA As Range, rngB As Range
    Dim ar, ar1, ar2, iLastRow As Long, SQL As String
    Dim i As Long, n As Long, id As String
    
    Set wb = ThisWorkbook
    Set wsOut = wb.Sheets("Sheet3")
 
    ' copy sheet1 Column A into array ar1
    iLastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).row
    Set rngA = Sheet1.Range("A1:A" & iLastRow)
    If rngA.Rows.Count = 1 Then
        ar1 = Array(0, rngA.Cells(1, 1).Value2)
    Else
        ar1 = Application.Transpose(rngA.Value2)
    End If
    'Debug.Print "A", LBound(ar1), UBound(ar1)

    ' copy sheet2 column B into array ar2
    iLastRow = Sheet2.Cells(Rows.Count, "B").End(xlUp).row
    Set rngB = Sheet2.Range("B1:B" & iLastRow)
    If rngB.Rows.Count = 1 Then
        ar2 = Array(0, rngB.Cells(1, 1).Value2)
    Else
        ar2 = Application.Transpose(rngB.Value2)
    End If
    'Debug.Print "B", LBound(ar2), UBound(ar2)

    ' connect to DB and create temporary table
    Dim oConn As New ADODB.Connection
    With oConn
        .ConnectionString = "driver={SQL Server};" & _
         "server=SERVER01;authenticateduser = TRUE;database=DATABASE01"
        .ConnectionTimeout = 30
        .Open
    End With

    oConn.Execute "CREATE TABLE #tmp (ID varchar(20) NOT NULL,PRIMARY KEY (ID ASC))"
    
    ' prepare insert query
    SQL = "INSERT INTO #tmp (ID) VALUES (?)"
    Dim cmd As New ADODB.Command
    With cmd
        .CommandType = adCmdText
        .ActiveConnection = oConn
        .CommandText = SQL
        .Parameters.Append .CreateParameter("p1", adVarChar, adParamInput, 20)
    End With
    
    ' insert array values into temp table
    Dim t0 As Single: t0 = Timer
    For Each ar In Array(ar1, ar2)
        oConn.BeginTrans
        For i = 1 To UBound(ar)
            id = Trim(ar(i))
            If Len(id) > 0 Then
                cmd.Execute n, id
            End If
        Next
        oConn.CommitTrans
        'Debug.Print i - 1 & " Inserted"
    Next
    n = oConn.Execute("SELECT COUNT(*) FROM #tmp")(0)
    'Debug.Print n & " records inserted into #tmp in " & Format(Timer - t0, "#.0 secs")

    ' select records using join as where filter
    SQL = " SELECT Ord.ID, Ord.OrderDate, Ord.Account" _
        & " FROM [tbl_Order] as Ord" _
        & " JOIN #tmp ON Ord.ID = #tmp.ID"
    
    ' output result
    Dim rs As New ADODB.Recordset
    Set rs = oConn.Execute(SQL, n)
    wsOut.Range("A:P").ClearContents
    
    ' header
    Dim fld, cell As Range
    Set cell = wsOut.Cells(5, 1)
    For Each fld In rs.Fields
        cell = fld.Name
        Set cell = cell.Offset(0, 1)
    Next
    
    ' data
    wsOut.Cells(6, 1).CopyFromRecordset rs
    oConn.Close
   
    ' end
    n = wsOut.Cells(Rows.Count, 1).End(xlUp).row - 6
    MsgBox n & " rows witten in " & Format(Timer - t0, "0.00 secs")
    
End Sub