Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/16.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel VBA CopyFromRecordset是否水平?_Excel_Vba - Fatal编程技术网

Excel VBA CopyFromRecordset是否水平?

Excel VBA CopyFromRecordset是否水平?,excel,vba,Excel,Vba,我找不到一个方法来使用 Range("A100").CopyFromRecordset myRecordSet 命令的方式将数据水平插入图纸中。该命令将垂直插入数据…:-\ 有什么想法吗?我想你需要做一个CopyFromRecordSet,然后进行复制粘贴转置。看看这个问题: 尝试以下操作: Dim oRst as ADODB.Recordset Dim vArray As Variant Dim oRange As Range oRst = Rst_From_Access(sSQL_Sel

我找不到一个方法来使用

Range("A100").CopyFromRecordset myRecordSet
命令的方式将数据水平插入图纸中。该命令将垂直插入数据…:-\


有什么想法吗?

我想你需要做一个CopyFromRecordSet,然后进行复制粘贴转置。看看这个问题:

尝试以下操作:

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
已从以下URL检索函数
Array2DTranspose


将数据粘贴到数组中的想法正如期发挥作用。至于Array2DTranspose函数,它正在对数组进行置乱。我没有进一步调查,因为这不是一个主要问题,因为数组中的数据已经正确排序。再次感谢你
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