Agregar un elemento al final de una matriz

14

Me gustaría agregar un valor al final de una matriz de VBA. ¿Cómo puedo hacer esto? No pude encontrar un ejemplo simple en línea. Aquí hay un pseudocódigo que muestra lo que me gustaría poder hacer.

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
fuente
¿Es la idea agregar valores al final de una matriz existente? ¿O es como su ejemplo en el que solo desea cargar un rango en una matriz? Si es esto último, ¿por qué no usar el one-liner arr = Range.Value?
Excellll

Respuestas:

10

Prueba esto [EDITADO]:

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
tipo
fuente
Gracias, pero desafortunadamente esto no funciona, ¿los UBound(arr)requisitos arrse inicializan con alguna dimensión, por ejemplo, Dim arr(1) As Variantpero luego ReDim Preservefalla y dice que la matriz ya está dimensionada? con otras palabras, no puedes redimir una matriz en VBA?
megloff
De acuerdo con msdn.microsoft.com/library/w8k3cys2.aspx deberías poder ...
duDE
Bueno, el ejemplo de msdn tampoco funciona en excel vba. mismo error, se queja de que ya está dimensionado gama
megloff
Parece que debería usarlo en lugar de una matriz a Collectiony luego convertirlo en una matriz. ¿Cualquier otra sugerencia?
megloff
2
Gracias, pero todavía no funciona de esta manera porque, como se mencionó anteriormente, UBound(arr)requiere una matriz ya dimensionada. Bueno, parece que tengo que usar una colección en su lugar. Gracias de todos modos
megloff
8

Resolví el problema usando una Colección y luego la copié a una matriz.

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
fuente
2
Si va a usar una Colección, también podría usar un Objeto de Diccionario. `Set col = CreateObject (" Scripting.Dictionary ")` Luego puede generar las claves directamente como una matriz y omitir su función agregada: `arr = col.keys` <= Array
B Hart
3

Así es como lo hago, usando una 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

O, si realmente necesita una matriz de Variantes (para pasar a una propiedad como Shapes.Range, por ejemplo), puede hacerlo de esta manera:

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
fuente
gracias, usando ReDim arr (0 a 0) y luego asignando el siguiente elemento funcionó para mí
Vasile Surdu
1

Si su rango es un vector único y, si está en una columna, el número de filas es menor que 16,384, puede usar el siguiente código:

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
fuente
0

Gracias. Hacer lo mismo con 2 funciones si puede ayudar a otros novatos como yo:

Colección

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

Matriz 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

Uso

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

La respuesta está en la respuesta aceptada en (sin el problema ReDim):

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

En resumen:

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
fuente
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
fuente