獲得從非連續範圍的聯合值到陣列VBA用一個簡單的命令（不循環）

Question

我有以下（它的表面上，簡單）任務：

拷貝從數字的值使用VBA將電子表格中的列轉換爲二維數組。

爲了讓生活更有趣，列不相鄰，但它們的長度都是相同的。顯然，人們可以通過循環遍歷每個元素來做到這一點，但這看起來很不雅觀。我希望有一個更緊湊的解決方案 - 但我很難找到它。

以下是我認爲「一種簡單的方法」的一些嘗試 - 爲了簡單起見，我將範圍設置爲A1:A5, D1:D5--總共10個單元格在兩個範圍內。

Private Sub testIt() 
    Dim r1, r2, ra, rd, rad 
    Dim valString, valUnion, valBlock 
    Set r1 = Range("A1:A5") 
    Set r2 = Range("D1:D5") 
    valString = Range("A1:A5,D1:D5").Value 
    valUnion = Union(r1, r2).Value 
    valBlock = Range("A1:D5").Value 
End Sub 

當我看着這些變量中，前兩個具有尺寸(1 To 5, 1 To 1)而最後一個具有(1 To 5, 1 To 4)。前兩次我期待得到(1 To 5, 1 To 2)，但事實並非如此。

我會很高興，如果我可以在當時循環數據一列，並將一列中的所有值分配給數組中的一列 - 但我無法弄清楚如何做到這一點。像

cNames = Array("A", "D") 
ci = 1 
For Each c in columnNames 
    vals(, ci) = Range(c & "1:" & c & "5").Value 
    ci = ci + 1 
Next c 

但是，有什麼地方不正確的語法。我想要得到的結果可以通過

cNames = Array("A", "D") 
ci = 1 
For Each c in columnNames 
    For ri = 1 To 5 
    vals(ri , ci) = Range(c & "1").offset(ri-1,0).Value 
    Next ri 
    ci = ci + 1 
Next c 

但是這很醜陋。所以這裏是我的問題：

是否有可能獲得一個「複合範圍」（多個非連續塊）的值到一個數組中 - 一次全部或一次一列？如果是這樣，我該怎麼做？

要獲得額外的獎勵積分 - 任何人都可以解釋爲什麼testIt()返回的數組的尺寸爲Base 1，而我的VBA設置爲Option Base 0？換句話說 - 他們爲什麼不是(0 To 4, 0 To 0)？這僅僅是微軟的一個不一致嗎？

Answer 1

如果在rng中的每個區域具有相同的行數，那麼這應該起作用。

Function ToArray(rng) As Variant() 
    Dim arr() As Variant, r As Long, nr As Long 
    Dim ar As Range, c As Range, cnum As Long, rnum As Long 
    Dim col As Range 

    nr = rng.Areas(1).Rows.Count 
    ReDim arr(1 To nr, 1 To rng.Cells.Count/nr) 
    cnum = 0 
    For Each ar In rng.Areas 
     For Each col In ar.Columns 
     cnum = cnum + 1 
     rnum = 1 
     For Each c In col.Cells 
      arr(rnum, cnum) = c.Value 
      rnum = rnum + 1 'EDIT: added missing line... 
     Next c 
     Next col 
    Next ar 

    ToArray = arr 
End Function 

用法：

Dim arr 
arr = ToArray(Activesheet.Range("A1:A5,D1:D5")) 
Debug.Print UBound(arr,1), UBound(arr,2) 

至於從rng.Value陣列是基於1 - 而不是爲什麼從零開始，我猜這是因爲映射更容易對實際行/列號而不是基於零的工作表。該Option Base x設置將被忽略

Answer 2

添，

感謝您的示例代碼。我遇到了一些問題，不得不重寫它的一些部分。它沒有正確計算行和列。我測試這和它的工作100％

Function ToArray(rng As Range) As Variant() 
Dim arr() As Variant, r As Long, nr As Long 
Dim ar As Range, c As Range, cnum As Long, rnum As Long 
Dim col As Range 
Dim lastrow As Integer 
Dim saverow() As Integer 
Dim lastcolumn As Integer 
Dim templastcolumn As Integer 
For i = 1 To rng.Areas.Count 
    templastcolumn = (rng.Areas(i).Column + rng.Areas(i).CountLarge) - 1 
    If lastrow <> rng.Areas(i).Row Then 
     nr = nr + rng.Areas(i).Rows.Count 
     lastrow = rng.Areas(i).Row 
    End If 
    If lastcolumn < templastcolumn Then lastcolumn = templastcolumn 
Next i 
ReDim arr(1 To nr, 1 To lastcolumn) 
ReDim saverow(1 To lastrow) 
cnum = 0 
rnum = 0 
lastrow = 0 
For Each ar In rng.Areas 
    If lastrow <> ar.Row Then 
     lastrow = ar.Row 
     cnum = 0 
    End If 
    For Each col In ar.Columns 
     cnum = cnum + 1 
     For Each c In col.Cells 
      If saverow(c.Row) = 0 Then 
       rnum = rnum + 1 
       saverow(c.Row) = rnum 
      End If 
      arr(saverow(c.Row), cnum) = c.value 
     Next c 
    Next col 
Next ar 
ToArray = arr 
End Function 

Sub TestCopyArray() 
Dim arr As Variant 

arr = ToArray(ThisWorkbook.Sheets("MSS").Range("B1:D2,G1:J2,B4:D4,B6:D6")) 
ThisWorkbook.Sheets("Sheet1").Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr 
End Sub 

Answer 3

它可以完成你想要什麼，如果你願意加入一個隱藏的工作表。我使用Excel 2010並創建了兩個工作表（Sheet1/Sheet2）來測試我的發現。下面是代碼：

Private Sub TestIt() 

    ' Src = source 
    ' Dst = destination 
    ' WS = worksheet 

    Dim Data As Variant 
    Dim SrcWS As Excel.Worksheet 
    Dim DstWS As Excel.Worksheet 

    ' Get a reference to the worksheet containing the 
    ' source data 
    Set SrcWS = ThisWorkbook.Worksheets("Sheet1") 

    ' Get a reference to a hidden worksheet. 
    Set DstWS = ThisWorkbook.Worksheets("Sheet2") 

    ' Delete any data found on the hidden worksheet 
    DstWS.UsedRange.Columns.EntireColumn.Delete 

    ' Copy the non-contiguous range into the hidden 
    ' worksheet. 
    SrcWS.Range("A1:A5,D1:D5").Copy DstWS.Range("A1") 

    ' Now all of the data can be stored in a variable 
    ' as a 2D array because it will be contiguous on 
    ' the hidden worksheet. 
    Data = DstWS.UsedRange.Value 

End Sub