7

私は次の（表面上は単純な）タスクを持っています：

VBA を使用して、スプレッドシートの多数の列の値を 2D 配列にコピーします。

生活をより面白くするために、列は隣接していませんが、すべて同じ長さです。明らかに、すべての要素を順番にループすることでこれを行うことができますが、それは非常に洗練されていないようです。もっとコンパクトな解決策があることを願っていますが、それを見つけるのに苦労しています。

ここに、私が「単純なアプローチ」と考える試みをいくつか示します。簡単にするために、範囲をA1:A5, D1:D52 つの範囲で合計 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

これらの変数のそれぞれを見ると、最初の 2 つは次元(1 To 5, 1 To 1)を持っていますが、最後の 1 つは を持ってい(1 To 5, 1 To 4)ます。最初の 2 つは取れると思っていました(1 To 5, 1 To 2)が、そうではありませんでした。

一度に 1 列ずつデータをループし、1 列のすべての値を配列の 1 列に割り当てることができれば幸いですが、その方法もわかりませんでした。何かのようなもの

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

しかし、それはかなり醜いです。だからここに私の質問があります：

「複合範囲」(複数の非連続ブロック) の値を配列に取得することは可能ですか?一度にすべて、または一度に列を取得できますか? もしそうなら、どうすればいいですか？

追加のボーナス ポイントとして、VBA が に設定されているのに、返される配列が である理由を説明できる人はいtestIt()ますか? 言い換えれば、なぜそうではないのですか？これは、Microsoft 側の矛盾の 1 つにすぎませんか?Base 1Option Base 0(0 To 4, 0 To 0)

4

3 に答える 3

0

ティム、

サンプルコードをありがとう。いくつか問題があり、一部を書き直さなければなりませんでした。行と列を正しくカウントしていませんでした。これをテストしましたが、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
于 2016-12-23T17:52:42.950 に答える