多次元配列からユーザ定義の寸法を抽出する

Question

multidimesion配列から2次元を抽出する関数が必要です。ユーザの選択に応じて2次元を抽出する。これらの2つの次元がユーザーによって選択された破棄された次元のインデックス。

たとえば、3次元配列v（1〜100,1〜20,1〜10）があります。 iは、Vの次元1と次元3 extratたい。及びdiscared寸法2のインデックスは11

sub extract 
dim i1 as integer 'for loop through dimension 1 
dim i2 as integer 'for loop through dimension 3 
dim d1 as integer 'index in dimension 2 
d1=11 
redim vn(1 to ubound(v,1),1 to ubound (v,3)) 
for i1 = 1 to ubound(v,1) 
    for i2= 1 to ubound(v,3) 
     vn(i1,i2)=v(i1,d1,i2) 
    next i2 
next i1 
end sub 

ある私は必要がある大きさを知っていれば、アレイからの寸法を抽出し、インデックス（D1ができます）を破棄した寸法で示す。しかし、私はそれをユーザーに任せて決定する必要があります。私がしたいと、そのような関数である：

function extract(i1 as integer, i2 as intger, paramarray ov()) as variant 

=エキス（the_first_dimension_to_keep、the_second_dimension_to_keep、[index_in_the_first_discard_dimension、index_in_the_second_discard_dimension、...]）origional配列が3つの以上の次元を持つことができることを念頭に置いて

キーピング、コード内のすべての可能性をリストすることはできません。

Answer 1

最も簡単な方法は、配列でポインタを読み取って、それぞれの次元数と要素数に基づいてアルゴリズム値でポインタ値をインクリメントすることです。このサイトには、配列へのポインタの管理に関する優れたチュートリアルがあります：http://bytecomb.com/vba-internals-getting-pointers。しかし、それは1つの強力なコーディングタスクです - ちょうどあなたのSAFEARRAYのの大きさをメモリの読み込みに合わせることはタスクになります。もしあなたの配列の値がStringsならば、それはもっと大きいかもしれません。

もっと簡単ではありませんが、遅くても、ループに適用するループ方法を利用することができます。この方法は配列に適用できます。ループのシーケンスは次のようになります。

arr(1,1) 
arr(2,1) 
arr(3,1) 
arr(1,2) 
arr(2,2) 
arr(3,2) 
etc. 

単純なオドメータースタイルのインデックスカウンタが必要です。

基本的には配列内のすべての要素を繰り返し処理することができます。インデックスの組み合わせが望むものと一致する場合は、要素を抽出配列に読み込みます。それははるかに簡単な作業になります。下のコードは、未知の次元の多次元配列でこれを行う方法を示しています。

Option Explicit 
Private Type ArrayBounds 
    Lower As Long 
    Upper As Long 
    Index As Long 
    WantedDimension As Boolean 
    DiscardIndex As Long 
End Type 
Public Sub RunMe() 
    Dim arr As Variant 
    Dim result As Variant 

    arr = CreateDummyArray 
    result = Extract(arr, 1, 3, 11) 

End Sub 
Private Function Extract(arr As Variant, i1 As Integer, i2 As Integer, ParamArray ov() As Variant) As Variant 
    Dim d As Long 
    Dim bounds() As ArrayBounds 
    Dim i As Long 
    Dim v As Variant 
    Dim ovIndex As Long 
    Dim doExtract As Boolean 
    Dim result() As Variant 

    'Dimension the output array 
    ReDim result(LBound(arr, i1) To UBound(arr, i1), LBound(arr, i2) To UBound(arr, i2)) 

    'Get no. of dimensions in array 
    d = GetDimension(arr) 

    'Now we know the number of dimensions, 
    'we can check that the passed parameters are correct 
    If (i1 < 1 Or i1 > d) Or (i2 < 1 Or i2 > d) Then 
     MsgBox "i1/i2 - out of range" 
     Exit Function 
    End If 

    If UBound(ov) - LBound(ov) + 1 <> d - 2 Then 
     MsgBox "ov - wrong number of args" 
     Exit Function 
    End If 

    'Resise and populate the bounds type array 
    ReDim bounds(1 To d) 
    ovIndex = LBound(ov) 
    For i = 1 To d 
     With bounds(i) 
      .Lower = LBound(arr, i) 
      .Upper = UBound(arr, i) 
      .Index = .Lower 
      .WantedDimension = (i = i1) Or (i = i2) 
      If Not .WantedDimension Then 
       .DiscardIndex = ov(ovIndex) 
       ovIndex = ovIndex + 1 
       'Check index is in range 
       If .DiscardIndex < .Lower Or .DiscardIndex > .Upper Then 
        MsgBox "ov - out of range" 
        Exit Function 
       End If 
      End If 
     End With 
    Next 

    'Iterate each member of the multi-dimensional array with a For Each 
    For Each v In arr 
     'Check if this combination of indexes is wanted for extract 
     doExtract = True 
     For i = 1 To d 
      With bounds(i) 
       If Not .WantedDimension And .Index <> .DiscardIndex Then 
        doExtract = False 
        Exit For 
       End If 
      End With 
     Next 

     'Write value into output array 
     If doExtract Then 
      result(bounds(i1).Index, bounds(i2).Index) = v 
     End If 

     'Increment the dimension index 
     For i = 1 To d 
      With bounds(i) 
       .Index = .Index + 1 
       If .Index > .Upper Then .Index = .Lower Else Exit For 
      End With 
     Next 

    Next 

    Extract = result 
End Function 
Private Function GetDimension(arr As Variant) As Long 
    'Helper function to obtain number of dimensions 
    Dim i As Long 
    Dim test As Long 

    On Error GoTo GotIt 
    For i = 1 To 60000 
     test = LBound(arr, i) 
    Next 
    Exit Function 
GotIt: 
    GetDimension = i - 1 
End Function