得到阵列

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限制然后通过各种手段使用它。如果您无法安全使用转置，请使用自定义功能。