得到陣列

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限制然後通過各種手段使用它。如果您無法安全使用轉置，請使用自定義功能。