Ajout d'un élément à la fin d'un tableau

14

Je voudrais ajouter une valeur à la fin d'un tableau VBA. Comment puis-je faire ceci? Je n'ai pas pu trouver un simple exemple en ligne. Voici un pseudocode montrant ce que j'aimerais pouvoir faire.

Public Function toArray(range As range)
 Dim arr() As Variant
 For Each a In range.Cells
  'how to add dynamically the value to end and increase the array?
   arr(arr.count) = a.Value 'pseudo code
 Next
toArray= Join(arr, ",")
End Function
megloff
la source
L'idée est-elle d'ajouter des valeurs à la fin d'un tableau existant? Ou est-ce comme votre exemple où vous voulez simplement charger une plage dans un tableau? Si ce dernier, pourquoi ne pas utiliser le one-liner arr = Range.Value?
Excellll

Réponses:

10

Essayez ceci [EDITED]:

Dim arr() As Variant ' let brackets empty, not Dim arr(1) As Variant !

For Each a In range.Cells
    ' change / adjust the size of array 
    ReDim Preserve arr(1 To UBound(arr) + 1) As Variant

    ' add value on the end of the array
    arr (UBound(arr)) = a.value
Next
mec
la source
Merci, mais malheureusement, cela ne fonctionne pas, l' UBound(arr)exige qui arrest initialisé avec une certaine dimension, par exemple, Dim arr(1) As Variantmais plus tard, il ReDim Preserveéchoue et dit que le tableau est déjà dimensionné? en d'autres termes, vous ne pouvez pas redimiter un tableau en VBA?
megloff
Selon msdn.microsoft.com/library/w8k3cys2.aspx, vous devriez pouvoir ...
duDE
Eh bien, l'exemple de msdn ne fonctionne pas non plus dans excel vba. même erreur, se plaint que le tableau est déjà dimensionné
megloff
Il semble que je devrais utiliser à la place d'un tableau a Collectionet le convertir ensuite en tableau. D'autres suggestions?
megloff
2
Merci, mais cela ne fonctionne toujours pas de cette façon car, comme mentionné précédemment, cela UBound(arr)nécessite un tableau déjà dimensionné. Eh bien, il semble que je doive utiliser une collection à la place. Merci quand même
megloff
8

J'ai résolu le problème en utilisant une collection et en la copiant ensuite dans un tableau.

Dim col As New Collection
For Each a In range.Cells
   col.Add a.Value  '  dynamically add value to the end
Next
Dim arr() As Variant
arr = toArray(col) 'convert collection to an array

Function toArray(col As Collection)
  Dim arr() As Variant
  ReDim arr(0 To col.Count-1) As Variant
  For i = 1 To col.Count
      arr(i-1) = col(i)
  Next
  toArray = arr
End Function
megloff
la source
2
Si vous allez utiliser une collection, vous pouvez tout aussi bien utiliser un objet dictionnaire. `Set col = CreateObject (" Scripting.Dictionary ")` Ensuite, vous pouvez sortir les clés directement sous forme de tableau et ignorer votre fonction ajoutée: `arr = col.keys` <= Array
B Hart
3

Voici comment je le fais, en utilisant une variable Variant (array):

Dim a As Range
Dim arr As Variant  'Just a Variant variable (i.e. don't pre-define it as an array)

For Each a In Range.Cells
    If IsEmpty(arr) Then
        arr = Array(a.value) 'Make the Variant an array with a single element
    Else
        ReDim Preserve arr(UBound(arr) + 1) 'Add next array element
        arr(UBound(arr)) = a.value          'Assign the array element
    End If
Next

Ou, si vous avez réellement besoin d'un tableau de variantes (pour passer à une propriété comme Shapes.Range, par exemple), vous pouvez le faire de cette façon:

Dim a As Range
Dim arr() As Variant

ReDim arr(0 To 0)                       'Allocate first element
For Each a In Range.Cells
    arr(UBound(arr)) = a.value          'Assign the array element
    ReDim Preserve arr(UBound(arr) + 1) 'Allocate next element
Next
ReDim Preserve arr(LBound(arr) To UBound(arr) - 1)  'Deallocate the last, unused element
pstraton
la source
merci, en utilisant ReDim arr (0 To 0) puis en allouant l'élément suivant a fonctionné pour moi
Vasile Surdu
1

Si votre plage est un vecteur unique et, si dans une colonne, le nombre de lignes est inférieur à 16 384, vous pouvez utiliser le code suivant:

Option Explicit
Public Function toArray(RNG As Range)
    Dim arr As Variant
    arr = RNG

    With WorksheetFunction
        If UBound(arr, 2) > 1 Then
            toArray = Join((.Index(arr, 1, 0)), ",")
        Else
            toArray = Join(.Transpose(.Index(arr, 0, 1)), ",")
        End If
    End With
End Function
Ron Rosenfeld
la source
0

THX. Faire de même avec 2 fonctions si cela peut aider d'autres noobs comme moi:

Collection

Function toCollection(ByVal NamedRange As String) As Collection
  Dim i As Integer
  Dim col As New Collection
  Dim Myrange As Variant, aData As Variant
  Myrange = Range(NamedRange)
  For Each aData In Myrange
    col.Add aData '.Value
  Next
  Set toCollection = col
  Set col = Nothing
End Function

Réseau 1D:

Function toArray1D(MyCollection As Collection)
    ' See http://superuser.com/a/809212/69050


  If MyCollection Is Nothing Then
    Debug.Print Chr(10) & Time & ": Collection Is Empty"
    Exit Function
  End If

  Dim myarr() As Variant
  Dim i As Integer
  ReDim myarr(1 To MyCollection.Count) As Variant

  For i = 1 To MyCollection.Count
      myarr(i) = MyCollection(i)
  Next i

  toArray1D = myarr
End Function

Usage

Dim col As New Collection
Set col = toCollection(RangeName(0))
Dim arr() As Variant
arr = toArray1D(col)
Set col = Nothing
hornetbzz
la source
0

La réponse se trouve dans la réponse acceptée en (sans le problème ReDim):

/programming/12663879/adding-values-to-variable-array-vba

En résumé:

Dim aArray() As Single ' or whatever data type you wish to use
ReDim aArray(1 To 1) As Single
If strFirstName = "henry" Then
    aArray(UBound(aArray)) = 123.45
    ReDim Preserve aArray(1 To UBound(aArray) + 1) As Single
End If
Leonardo Rebolledo
la source
0
Dim arr()  As Variant: ReDim Preserve arr(0) ' Create dynamic array

' Append to dynamic array function
Function AppendArray(arr() As Variant, var As Variant) As Variant
    ReDim Preserve arr(LBound(arr) To UBound(arr) + 1) ' Resize array, add index
    arr(UBound(arr) - 1) = var ' Append to array
End Function
Cuinn Herrick
la source