Adicionando um elemento ao final de uma matriz


14

Eu gostaria de adicionar um valor ao final de uma matriz VBA. Como posso fazer isso? Não consegui encontrar um exemplo simples online. Aqui estão alguns pseudocódigo mostrando o que eu gostaria de poder fazer.

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

A ideia é adicionar valores ao final de uma matriz existente? Ou é como o seu exemplo, onde você deseja apenas carregar um intervalo em uma matriz? Neste último caso, por que não usar o one-liner arr = Range.Value?
Excellll

Respostas:


10

Tente isto [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

Obrigado, mas infelizmente isso não funciona, o UBound(arr)requer que arré inicializado com alguma dimensão, por exemplo, Dim arr(1) As Variantmas depois o ReDim Preserveestá falhando e diz que o array já está dimensionado? com outras palavras, você não pode redimitar uma matriz no VBA?
megloff

De acordo com msdn.microsoft.com/library/w8k3cys2.aspx, você deve ...
duDE

Bem, o exemplo do msdn também não funciona no excel vba. mesmo erro, reclama que matriz já está dimensionado
megloff

Parece que eu deveria usar em vez de uma matriz de um Collectione convertê-lo posteriormente para uma matriz. Alguma outra sugestão?
megloff 9/09/14

2
Obrigado, mas ainda não funciona dessa maneira, porque, como mencionado anteriormente, UBound(arr)requer uma matriz já dimensionada. Bem, parece que eu tenho que usar uma coleção. Obrigado de qualquer maneira
megloff

8

Resolvi o problema usando uma coleção e copiei-o posteriormente para uma 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

2
Se você for usar uma coleção, também poderá usar um objeto de dicionário. `Set col = CreateObject (" Scripting.Dictionary ")` Então você pode enviar as chaves diretamente como uma matriz e pular a sua função adicionada: `arr = col.keys` <= Array
B Hart

3

É assim que eu faço, usando uma variável 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, se você realmente precisar de uma matriz de Variantes (para passar para uma propriedade como Shapes.Range, por exemplo), poderá fazê-lo desta maneira:

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

graças, USANDO ReDim arr (0 a 0) e, em seguida, alocar o elemento seguinte trabalhou para mim
Vasile Surdu

1

Se o seu intervalo for um vetor único e, em uma coluna, o número de linhas for menor que 16.384, você poderá usar o seguinte 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

0

Valeu. Fazendo o mesmo com 2 funções, se puder ajudar outros noobs como eu:

Coleção

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


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
Ao utilizar nosso site, você reconhece que leu e compreendeu nossa Política de Cookies e nossa Política de Privacidade.
Licensed under cc by-sa 3.0 with attribution required.