extrahieren benutzerdefinierte Dimensionen aus Multidimension Array

Question

Ich brauche eine Funktion, um 2 Dimensionen aus einem Multidimensions-Array zu extrahieren. Welche 2 Dimensionen sind abhängig von der Wahl des Benutzers. und der Index in den verworfenen Dimensionen, in denen diese 2 Dimensionen ausgewählt sind, hängt auch vom Benutzer ab.

Zum Beispiel habe ich ein 3-dimensionales Array v (1 bis 100, 1 bis 20, 1 bis 10). Ich möchte Dimension extrat 1 und 3 Dimension von v., und der Index in Dimension der 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 

I Abmessungen von Array extrahieren, wenn ich weiß, welche Dimensionen ich brauche und der Index (d1) in den verworfenen Dimensionen. Allerdings muss ich dies den Nutzern überlassen, um zu entscheiden. was ich will, ist eine Funktion wie folgt aus:

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

= Extrakt (the_first_dimension_to_keep, the_second_dimension_to_keep, [index_in_the_first_discard_dimension, index_in_the_second_discard_dimension, ...])

Unter Berücksichtigung der Tatsache, dass die ursprüngliche Anordnung mehr als 3 Dimensionen haben kann , also listet alle Möglichkeiten im Code auf, ist nicht möglich.

Irgendeine Lösung?

Answer 1

Der schnellste Weg wäre, das Array mit einem Zeiger zu lesen und den Zeigerwert um einen algorithmischen Wert zu erhöhen, der auf der Anzahl der Dimensionen und der Anzahl der Elemente basiert. Diese Website verfügt über ein hervorragendes Lernprogramm zum Verwalten von Zeigern auf Arrays: http://bytecomb.com/vba-internals-getting-pointers. Es wäre jedoch eine mächtige Coding-Aufgabe - nur die rgabounds von Ihrem SAFEARRAY für das Lesen des Speichers zu dimensionieren wäre eine Aufgabe - und wenn Ihre Array-Werte Strings wären, wäre es um eine Größenordnung größer.

Eine einfachere, aber zweifellos langsamere Option wäre die Verwendung der For Each Schleifenmethode, die auf ein Array angewendet werden kann. Seine Looping-Sequenz ist wie folgt:

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

So würden Sie nur eine einfache Odometer-Stil-Index-Zähler benötigen.

Sie könnten im Grunde jedes Element im Array iterieren und wenn die Kombination der Indizes mit Ihren Wünschen übereinstimmt, würden Sie das Element in Ihr Extraktionsfeld lesen. Das wäre eine viel einfachere Aufgabe. Der folgende Code zeigt Ihnen, wie Sie dies in einem mehrdimensionalen Array unbekannter Dimensionen tun können.

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