Arrays 获取整个数组行

我有下面的代码

我想得到整个行，而不仅仅是原始数组的第1列，我该怎么做

Sub Example1()
    Dim arrValues() As Variant
    Dim lastRow As Long
    Dim filteredArray()
    Dim lRow As Long
    Dim lCount As Long
    Dim tempArray()

    lastRow = Sheets("Raw Data").UsedRange.Rows(Sheets("Raw Data").UsedRange.Rows.Count).Row
    arrValues = Sheets("Raw Data").Range(Cells(2, 1), Cells(lastRow, 21)).Value

    ' First use a temporary array with just one dimension
    ReDim tempArray(1 To UBound(arrValues))
    For lCount = 1 To UBound(arrValues)
        If arrValues(lCount, 3) = "phone" Then
            lRow = lRow + 1
            tempArray(lRow) = arrValues(lCount, 1)
        End If
    Next

    ' Now we know how large the filteredArray needs to be: copy the found values into it
    ReDim filteredArray(1 To lRow, 1 To 1)
    For lCount = 1 To lRow
        filteredArray(lCount, 1) = tempArray(lCount)
    Next

    Sheets("L").Range("A2:U" & 1 + lRow) = filteredArray
End Sub

可以使用PRESERVE参数动态添加记录，但只能添加到最后一列。这是一个问题，因为二维数组的第二列通常被视为“列”，而第一列是“行”

应用程序.Transpose

可以将行翻转为列，反之亦然，但它有局限性。（见和）

一个没有这些限制的简单转置函数实际上非常容易构建。您真正需要的只是两个数组和两个嵌套循环来翻转它们

Sub Example1()
    Dim arrVALs() As Variant, arrPHONs() As Variant
    Dim v As Long, w As Long

    With Sheets("Raw Data").Cells(1, 1).CurrentRegion
        With .Resize(.Rows.Count - 1, 21).Offset(1, 0)
            arrVALs = .Cells.Value
            'array dimension check
            'Debug.Print LBound(arrVALs, 1) & ":" & UBound(arrVALs, 1)
            'Debug.Print LBound(arrVALs, 2) & ":" & UBound(arrVALs, 2)
            'Debug.Print Application.CountIf(.Columns(3), "phone") & " phones"
        End With
    End With

    ReDim arrPHONs(1 To UBound(arrVALs, 2), 1 To 1)
    For v = LBound(arrVALs, 1) To UBound(arrVALs, 1)
        If LCase(arrVALs(v, 3)) = "phone" Then
            For w = LBound(arrVALs, 2) To UBound(arrVALs, 2)
                arrPHONs(w, UBound(arrPHONs, 2)) = arrVALs(v, w)
            Next w
            ReDim Preserve arrPHONs(1 To UBound(arrPHONs, 1), _
                                    1 To UBound(arrPHONs, 2) + 1)
        End If
    Next v

    'there is 1 too many in the filtered array
    ReDim Preserve arrPHONs(1 To UBound(arrPHONs, 1), _
                            1 To UBound(arrPHONs, 2) - 1)

    'array dimension check
    'Debug.Print LBound(arrPHONs, 1) & ":" & UBound(arrPHONs, 1)
    'Debug.Print LBound(arrPHONs, 2) & ":" & UBound(arrPHONs, 2)

    'Option 1: use built-in Transpose
    'Worksheets("L").Range("A2:U" & UBound(arrPHONs, 2) + 1) = Application.Transpose(arrPHONs)

    'Option 2: use custom my_2D_Transpose
    Worksheets("L").Range("A2:U" & UBound(arrPHONs, 2) + 1) = my_2D_Transpose(arrPHONs)

End Sub

Function my_2D_Transpose(arr As Variant)
    Dim a As Long, b As Long, tmp() As Variant
    ReDim tmp(1 To UBound(arr, 2), 1 To UBound(arr, 1))
    For a = LBound(arr, 1) To UBound(arr, 1)
        For b = LBound(arr, 2) To UBound(arr, 2)
            tmp(b, a) = Trim(arr(a, b))
        Next b
    Next a
    my_2D_Transpose = tmp
End Function

---

因此，如果您很匆忙，而且数组的范围太大，您将永远无法达到

应用程序的极限。请务必使用它。如果您不能安全地使用转置，请使用自定义函数。
=application.transpose（filteredArray）
应该可以。由于某些原因，此函数和例程非常有效。第一列中的日期在该过程中似乎改变了其格式。原始数据是2015年11月5日，但最终显示在工作表（“L”中）由于2015年5月11日VBA非常以美国为中心。我建议更改为
arrVALs=.Cells.Value2
，并使用工作表的单元格格式实现您的DMY日期格式。2015年11月5日将显示为42313，直到您格式化它。