Dodanie elementu na końcu tablicy

14

Chciałbym dodać wartość na końcu tablicy VBA. W jaki sposób mogę to zrobić? Nie udało mi się znaleźć prostego przykładu online. Oto pseudokod pokazujący, co chciałbym móc zrobić.

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
źródło
Czy pomysł polega na dodaniu wartości na końcu istniejącej tablicy? A może to twój przykład, w którym chcesz po prostu załadować zakres do tablicy? Jeśli to drugie, dlaczego nie skorzystać z jednowarstwowej arr = Range.Value?
Excellll,

Odpowiedzi:

10

Spróbuj tego [EDYCJI]:

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
koleś
źródło
Dzięki, ale niestety to nie działa. Wymagania, UBound(arr)które arrzostały zainicjowane przy pomocy jakiegoś dimenstionu, np. Dim arr(1) As VariantPóźniej ReDim Preservenie działa i mówi, że tablica jest już zwymiarowana? innymi słowy nie możesz zredukować tablicy w VBA?
megloff,
Według msdn.microsoft.com/library/w8k3cys2.aspx powinieneś ...
duDE
Przykład z msdn również nie działa w programie Excel VBA. ten sam błąd, narzeka, że ​​tablica jest już zwymiarowana
megloff,
Wygląda na to, że powinienem użyć zamiast tablicy a Collectioni przekonwertować ją później na tablicę. Jakieś inne sugestie?
megloff,
2
Dziękuję, ale nadal nie działa w ten sposób, ponieważ, jak wspomniano wcześniej, UBound(arr)wymaga już zwymiarowanej tablicy. Wygląda na to, że zamiast tego muszę użyć kolekcji. W każdym razie dziękuję
megloff,
9

Rozwiązałem problem za pomocą kolekcji i skopiowałem go później do tablicy.

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
źródło
2
Jeśli zamierzasz użyć kolekcji, równie dobrze możesz użyć obiektu słownikowego. `Set col = CreateObject (" Scripting.Dictionary ")` Następnie możesz wyprowadzić klucze bezpośrednio jako tablicę i pominąć dodaną funkcję: `arr = col.keys` <= Array
B Hart
3

Tak to robię, używając zmiennej Variant (tablica):

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

Lub, jeśli faktycznie potrzebujesz tablicy Warianty (aby przejść do właściwości takiej jak Shapes.Range, na przykład), możesz to zrobić w ten sposób:

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
źródło
dzięki, użycie ReDim arr (0 do 0), a następnie przydzielenie następnego elementu działało dla mnie
Vasile Surdu 15'18
1

Jeśli twój zakres jest pojedynczym wektorem, a jeśli w kolumnie liczba wierszy jest mniejsza niż 16 384, możesz użyć następującego kodu:

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
źródło
0

Dzięki. Robię to samo z 2 funkcjami, jeśli może pomóc innym noobom takim jak ja:

Kolekcja

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

Tablica 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

Stosowanie

Dim col As New Collection
Set col = toCollection(RangeName(0))
Dim arr() As Variant
arr = toArray1D(col)
Set col = Nothing
hornetbzz
źródło
0

Odpowiedź znajduje się w zaakceptowanej odpowiedzi w (bez problemu ReDim):

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

W CV:

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
źródło
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
źródło