arrays - 获取数组的整行

Question

我下面有以下代码，

我想要获取整行，而不仅仅是原始数组的第 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

Answer 1

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

Application.Transpose 可以将行翻转为列，反之亦然，但它有局限性。 (参见here和here)

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

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 的限制，那么请务必使用它。如果您无法安全地使用转置，请使用自定义函数。