Conserver ReDim dans un tableau multidimensionnel dans Visual Basic 6

Question

J'utilise VB6 et j'ai besoin de faire une conservation ReDim sur un tableau multidimensionnel:

 Dim n, m As Integer
    n = 1
    m = 0
    Dim arrCity() As String
    ReDim arrCity(n, m)

    n = n + 1
    m = m + 1
    ReDim Preserve arrCity(n, m)

Chaque fois que je le fais tel que je l'ai écrit, j'obtiens l'erreur suivante:

erreur d'exécution 9: indice hors limites

Parce que je ne peux changer que la dernière dimension du tableau, eh bien dans ma tâche je dois changer tout le tableau (2 dimensions dans mon exemple)!

Existe-t-il une solution de contournement ou une autre solution pour cela?

Answer 1

Comme vous le signalez correctement, on peut ReDim Preserve uniquement la dernière dimension d'un tableau ( ReDim Statement sur MSDN):

Si vous utilisez le mot clé Conserver, vous ne pouvez redimensionner que la dernière dimension du tableau et vous ne pouvez pas du tout modifier le nombre de dimensions. Par exemple, si votre tableau n'a qu'une seule dimension, vous pouvez redimensionner cette dimension car il s'agit de la dernière et seule dimension. Cependant, si votre tableau a deux dimensions ou plus, vous pouvez modifier la taille de la dernière dimension uniquement et conserver le contenu du tableau

Par conséquent, la première question à décider est de savoir si le tableau à 2 dimensions est la meilleure structure de données pour le travail. Peut-être qu'un tableau unidimensionnel convient mieux que vous devez le faire ReDim Preserve?

Une autre façon est d'utiliser un tableau dentelé selon suggestion de Pieter Geerkens . Il n'y a pas de prise en charge directe pour les tableaux irréguliers dans VB6. Une façon de coder "tableau de tableaux" dans VB6 est de déclarer un tableau de Variant et de faire de chaque élément un tableau du type souhaité (String dans votre cas). Le code de démonstration est ci-dessous.

Une autre option consiste à implémenter vous-même Preserve part. Pour cela, vous devrez créer une copie des données à conserver, puis remplir le tableau redimensionné avec.

Option Explicit

Public Sub TestMatrixResize()
    Const MAX_D1 As Long = 2
    Const MAX_D2 As Long = 3

    Dim arr() As Variant
    InitMatrix arr, MAX_D1, MAX_D2
    PrintMatrix "Original array:", arr

    ResizeMatrix arr, MAX_D1 + 1, MAX_D2 + 1
    PrintMatrix "Resized array:", arr
End Sub

Private Sub InitMatrix(a() As Variant, n As Long, m As Long)
    Dim i As Long, j As Long
    Dim StringArray() As String

    ReDim a(n)
    For i = 0 To n
        ReDim StringArray(m)
        For j = 0 To m
            StringArray(j) = i * (m + 1) + j
        Next j
        a(i) = StringArray
    Next i
End Sub

Private Sub PrintMatrix(heading As String, a() As Variant)
    Dim i As Long, j As Long
    Dim s As String

    Debug.Print heading
    For i = 0 To UBound(a)
        s = ""
        For j = 0 To UBound(a(i))
            s = s & a(i)(j) & "; "
        Next j
        Debug.Print s
    Next i
End Sub

Private Sub ResizeMatrix(a() As Variant, n As Long, m As Long)
    Dim i As Long
    Dim StringArray() As String

    ReDim Preserve a(n)
    For i = 0 To n - 1
        StringArray = a(i)
        ReDim Preserve StringArray(m)
        a(i) = StringArray
    Next i
    ReDim StringArray(m)
    a(n) = StringArray
End Sub

Answer 2

Puisque VB6 est très similaire à VBA, je pense que je pourrais avoir une solution qui n'exige pas autant de code pour ReDim un tableau à 2 dimensions - en utilisant Transpose.

La solution (VBA):

Dim n, m As Integer
n = 2
m = 1
Dim arrCity() As Variant
ReDim arrCity(1 To n, 1 To m)

m = m + 1
ReDim Preserve arrCity(1 To n, 1 To m)
arrCity = Application.Transpose(arrCity)
n = n + 1
ReDim Preserve arrCity(1 To m, 1 To n)
arrCity = Application.Transpose(arrCity)

Ce qui est différent de la question d'OP: la limite inférieure du tableau arrCity n'est pas 0, mais 1. Ceci afin de laisser Application.Transpose fais son boulot.

Je pense que vous devriez avoir la méthode Transpose dans VB6.

Answer 3

À cet égard:

"dans ma tâche, je dois changer l'ensemble du tableau (2 dimensions"

Utilisez simplement un tableau dentelé (c'est-à-dire un tableau de tableaux de valeurs). Ensuite, vous pouvez modifier les dimensions à votre guise. Un peu plus de travail peut-être, mais une solution.

Answer 4

Je n'ai pas testé chacune de ces réponses, mais vous n'avez pas besoin d'utiliser des fonctions compliquées pour y parvenir. C'est tellement plus simple que ça! Mon code ci-dessous fonctionnera dans n'importe quelle application VBA de bureau (Word, Access, Excel, Outlook, etc.) et est très simple. J'espère que cela t'aides:

''Dimension 2 Arrays
Dim InnerArray(1 To 3) As Variant ''The inner is for storing each column value of the current row
Dim OuterArray() As Variant ''The outer is for storing each row in
Dim i As Byte

    i = 1
    Do While i <= 5

        ''Enlarging our outer array to store a/another row
        ReDim Preserve OuterArray(1 To i)

        ''Loading the current row column data in
        InnerArray(1) = "My First Column in Row " & i
        InnerArray(2) = "My Second Column in Row " & i
        InnerArray(3) = "My Third Column in Row " & i

        ''Loading the entire row into our array
        OuterArray(i) = InnerArray

        i = i + 1
    Loop

    ''Example print out of the array to the Intermediate Window
    Debug.Print OuterArray(1)(1)
    Debug.Print OuterArray(1)(2)
    Debug.Print OuterArray(2)(1)
    Debug.Print OuterArray(2)(2)

Answer 5

Je sais que c'est un peu vieux mais je pense qu'il pourrait y avoir une solution beaucoup plus simple qui ne nécessite aucun codage supplémentaire:

Au lieu de transposer, de réduire et de transposer à nouveau, et si nous parlons d'un tableau à deux dimensions, pourquoi ne pas simplement stocker les valeurs transposées pour commencer. Dans ce cas, la conservation de redim augmente en fait la bonne (deuxième) dimension dès le départ. Ou en d'autres termes, pour le visualiser, pourquoi ne pas stocker sur deux lignes au lieu de deux colonnes si seul le nombre de colonnes peut être augmenté avec redim préserver.

les indices seraient alors 00-01, 01-11, 02-12, 03-13, 04-14, 05-15 ... 0 25-1 25 etcetera au lieu de 00-01, 10-11, 20-21 , 30-31, 40-41 etcetera.

Tant qu'il n'y a qu'une seule dimension qui doit être redéfinie-préservée, l'approche fonctionnerait toujours: il suffit de mettre cette dimension en dernier.

Étant donné que seule la deuxième (ou dernière) dimension peut être préservée lors de la réduction, on pourrait peut-être affirmer que c'est ainsi que les tableaux sont censés être utilisés pour commencer. Je n'ai vu cette solution nulle part, alors peut-être que j'oublie quelque chose?

(Publié plus tôt sur une question similaire concernant les deux dimensions, réponse étendue ici pour plus de dimensions)

Answer 6

Vous pouvez utiliser un type défini par l'utilisateur contenant un tableau de chaînes qui sera le tableau interne. Ensuite, vous pouvez utiliser un tableau de ce type défini par l'utilisateur comme tableau externe.

Jetez un œil au projet de test suivant:

'1 form with:
'  command button: name=Command1
'  command button: name=Command2
Option Explicit

Private Type MyArray
  strInner() As String
End Type

Private mudtOuter() As MyArray

Private Sub Command1_Click()
  'change the dimensens of the outer array, and fill the extra elements with "1"
  Dim intOuter As Integer
  Dim intInner As Integer
  Dim intOldOuter As Integer
  intOldOuter = UBound(mudtOuter)
  ReDim Preserve mudtOuter(intOldOuter + 2) As MyArray
  For intOuter = intOldOuter + 1 To UBound(mudtOuter)
    ReDim mudtOuter(intOuter).strInner(intOuter) As String
    For intInner = 0 To UBound(mudtOuter(intOuter).strInner)
      mudtOuter(intOuter).strInner(intInner) = "1"
    Next intInner
  Next intOuter
End Sub

Private Sub Command2_Click()
  'change the dimensions of the middle inner array, and fill the extra elements with "2"
  Dim intOuter As Integer
  Dim intInner As Integer
  Dim intOldInner As Integer
  intOuter = UBound(mudtOuter) / 2
  intOldInner = UBound(mudtOuter(intOuter).strInner)
  ReDim Preserve mudtOuter(intOuter).strInner(intOldInner + 5) As String
  For intInner = intOldInner + 1 To UBound(mudtOuter(intOuter).strInner)
    mudtOuter(intOuter).strInner(intInner) = "2"
  Next intInner
End Sub

Private Sub Form_Click()
  'clear the form and print the outer,inner arrays
  Dim intOuter As Integer
  Dim intInner As Integer
  Cls
  For intOuter = 0 To UBound(mudtOuter)
    For intInner = 0 To UBound(mudtOuter(intOuter).strInner)
      Print CStr(intOuter) & "," & CStr(intInner) & " = " & mudtOuter(intOuter).strInner(intInner)
    Next intInner
    Print "" 'add an empty line between the outer array elements
  Next intOuter
End Sub

Private Sub Form_Load()
  'init the arrays
  Dim intOuter As Integer
  Dim intInner As Integer
  ReDim mudtOuter(5) As MyArray
  For intOuter = 0 To UBound(mudtOuter)
    ReDim mudtOuter(intOuter).strInner(intOuter) As String
    For intInner = 0 To UBound(mudtOuter(intOuter).strInner)
      mudtOuter(intOuter).strInner(intInner) = CStr((intOuter + 1) * (intInner + 1))
    Next intInner
  Next intOuter
  WindowState = vbMaximized
End Sub

Exécutez le projet et cliquez sur le formulaire pour afficher le contenu des tableaux.

Cliquez sur Command1 pour agrandir le tableau externe, puis cliquez à nouveau sur le formulaire pour afficher les résultats.

Cliquez sur Command2 pour agrandir un tableau interne, puis cliquez à nouveau sur le formulaire pour afficher les résultats.

Attention cependant: lorsque vous redimitez le tableau externe, vous devez également redimposer les tableaux internes pour tous les nouveaux éléments du tableau externe

Answer 7

Je suis tombé sur cette question en frappant moi-même ce barrage routier. J'ai fini par écrire un morceau de code très rapidement pour gérer ce ReDim Preserve Sur un nouveau tableau de taille (première ou dernière dimension). Peut-être que cela aidera d'autres personnes confrontées au même problème.

Donc, pour l'utilisation, disons que votre tableau est initialement défini comme MyArray(3,5), et que vous souhaitez agrandir les dimensions (d'abord aussi!), Disons simplement à MyArray(10,20). Vous seriez habitué à faire quelque chose comme ça non?

 ReDim Preserve MyArray(10,20) '<-- Returns Error

Mais malheureusement, cela renvoie une erreur car vous avez essayé de modifier la taille de la première dimension. Donc avec ma fonction, vous feriez juste quelque chose comme ça à la place:

 MyArray = ReDimPreserve(MyArray,10,20)

Maintenant, le tableau est plus grand et les données sont préservées. Votre ReDim Preserve Pour un tableau multidimensionnel est terminé. :)

Et enfin et surtout, la fonction miraculeuse: ReDimPreserve()

'redim preserve both dimensions for a multidimension array *ONLY
Public Function ReDimPreserve(aArrayToPreserve,nNewFirstUBound,nNewLastUBound)
    ReDimPreserve = False
    'check if its in array first
    If IsArray(aArrayToPreserve) Then       
        'create new array
        ReDim aPreservedArray(nNewFirstUBound,nNewLastUBound)
        'get old lBound/uBound
        nOldFirstUBound = uBound(aArrayToPreserve,1)
        nOldLastUBound = uBound(aArrayToPreserve,2)         
        'loop through first
        For nFirst = lBound(aArrayToPreserve,1) to nNewFirstUBound
            For nLast = lBound(aArrayToPreserve,2) to nNewLastUBound
                'if its in range, then append to new array the same way
                If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
                    aPreservedArray(nFirst,nLast) = aArrayToPreserve(nFirst,nLast)
                End If
            Next
        Next            
        'return the array redimmed
        If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
    End If
End Function

J'ai écrit ça en 20 minutes environ, donc il n'y a aucune garantie. Mais si vous souhaitez l'utiliser ou l'étendre, n'hésitez pas. J'aurais pensé que quelqu'un aurait déjà eu un code comme celui-là, eh bien, apparemment non. Alors voilà les autres réducteurs.

Answer 8

Ceci est plus compact et respecte la première position initiale dans le tableau et utilise simplement la limite initiale pour ajouter une ancienne valeur.

Public Sub ReDimPreserve(ByRef arr, ByVal size1 As Long, ByVal size2 As Long)
Dim arr2 As Variant
Dim x As Long, y As Long

'Check if it's an array first
If Not IsArray(arr) Then Exit Sub

'create new array with initial start
ReDim arr2(LBound(arr, 1) To size1, LBound(arr, 2) To size2)

'loop through first
For x = LBound(arr, 1) To UBound(arr, 1)
    For y = LBound(arr, 2) To UBound(arr, 2)
        'if its in range, then append to new array the same way
        arr2(x, y) = arr(x, y)
    Next
Next
'return byref
arr = arr2
End Sub

J'appelle ce sous avec cette ligne pour redimensionner la première dimension

ReDimPreserve arr2, UBound(arr2, 1) + 1, UBound(arr2, 2)

Vous pouvez ajouter un autre test pour vérifier si la taille initiale n'est pas supérieure au nouveau tableau. Dans mon cas, ce n'est pas nécessaire

Answer 9

Le moyen le plus simple de le faire dans VBA est de créer une fonction qui prend un tableau, votre nouvelle quantité de lignes et une nouvelle quantité de colonnes.

Exécutez la fonction ci-dessous pour copier toutes les anciennes données dans le tableau une fois qu'elles ont été redimensionnées.

 function dynamic_preserve(array1, num_rows, num_cols)

        dim array2 as variant

        array2 = array1

        reDim array1(1 to num_rows, 1 to num_cols)

        for i = lbound(array2, 1) to ubound(array2, 2)

               for j = lbound(array2,2) to ubound(array2,2)

                      array1(i,j) = array2(i,j)

               next j

        next i

        dynamic_preserve = array1

end function