水平Excel VBA CopyFromRecordset？

Question

我無法找到一種方法在某種程度上數據使用

Range("A100").CopyFromRecordset myRecordSet 

命令將被在片水平地插入。該命令將垂直插入數據...： - \

任何想法？

Answer 1

嘗試以下操作：

Dim oRst as ADODB.Recordset 
Dim vArray As Variant 
Dim oRange As Range 

oRst = Rst_From_Access(sSQL_Select) 'Some function that gets whatever recordset 
ReDim vArray(1 To oRst.RecordCount, 1 To oRst.RecordCount) 
vArray = oRst.GetRows 'Load recordset into an array 
vArray = Array2DTranspose(vArray) 'Transpose the array 
Set oRange = oBook.Sheets(1).Range(Cells(1, 1), Cells(UBound(vArray, 1), UBound(vArray, 2))) 'Wherever you want to paste the array. 
oRange = vArray 'Paste the array 

功能Array2DTranspose從以下網址獲得：
http://www.visualbasic.happycodings.com/Applications-VBA/code30.html

Function Array2DTranspose(avValues As Variant) As Variant 
Dim lThisCol As Long, lThisRow As Long 
Dim lUb2 As Long, lLb2 As Long 
Dim lUb1 As Long, lLb1 As Long 
Dim avTransposed As Variant 

If IsArray(avValues) Then 
    On Error GoTo ErrFailed 
    lUb2 = UBound(avValues, 2) 
    lLb2 = LBound(avValues, 2) 
    lUb1 = UBound(avValues, 1) 
    lLb1 = LBound(avValues, 1) 

    ReDim avTransposed(lLb2 To lUb2, lLb1 To lUb1) 
    For lThisCol = lLb1 To lUb1 
     For lThisRow = lLb2 To lUb2 
      avTransposed(lThisRow, lThisCol) = avValues(lThisCol, lThisRow) 
     Next 
    Next 
End If 

Array2DTranspose = avTransposed 
Exit Function 

ErrFailed: 
Debug.Print Err.Description 
Debug.Assert False 
Array2DTranspose = Empty 
Exit Function 
Resume 
End Function 

Answer 2

我認爲你需要做一個CopyFromRecordSet然後複製和粘貼轉置。看看這個問題：

Transposing CopyFromRecordset Excel VBA