Menambahkan elemen ke akhir array


14

Saya ingin menambahkan nilai pada akhir array VBA. Bagaimana saya bisa melakukan ini? Saya tidak dapat menemukan contoh online yang sederhana. Inilah beberapa pseudocode yang menunjukkan apa yang ingin saya lakukan.

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

Apakah ide untuk menambahkan nilai ke akhir array yang ada? Atau apakah itu seperti contoh Anda di mana Anda hanya ingin memuat rentang ke dalam array? Jika yang terakhir, mengapa tidak menggunakan one-liner arr = Range.Value?
Excellll

Jawaban:


10

Coba ini [DIedit]:

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

Terima kasih tapi sayangnya ini tidak berfungsi, kebutuhan UBound(arr)yang arrdiinisialisasi dengan beberapa dimenstion misalnya Dim arr(1) As Varianttetapi kemudian ReDim Preservegagal dan mengatakan bahwa array sudah dimensinya? dengan kata lain Anda tidak bisa redim array di VBA?
megloff

Menurut msdn.microsoft.com/library/w8k3cys2.aspx Anda seharusnya bisa ...
duDE

Nah contoh dari msdn juga tidak berfungsi di excel vba. kesalahan yang sama, mengeluh bahwa array sudah dimensinya
megloff

Sepertinya saya harus menggunakan bukan array Collectiondan mengubahnya kemudian menjadi array. Ada saran lain?
megloff

2
Terima kasih tetapi masih tidak bekerja dengan cara ini karena seperti yang disebutkan sebelumnya UBound(arr)memerlukan array yang sudah dimensi. Sepertinya saya harus menggunakan koleksi. Terima kasih
megloff

8

Saya memecahkan masalah dengan menggunakan Koleksi dan menyalinnya setelah itu ke array.

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
Jika Anda akan menggunakan Koleksi, Anda mungkin juga menggunakan Obyek Kamus. `Set col = CreateObject (" Scripting.Dictionary ")` Kemudian Anda dapat menampilkan Kunci secara langsung sebagai array dan melewatkan fungsi tambahan Anda: `arr = col.keys` <= Array
B Hart

3

Ini adalah bagaimana saya melakukannya, menggunakan variabel (array) variabel:

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

Atau, jika Anda benar-benar membutuhkan array Varian (untuk meneruskan ke properti seperti Shapes.Range, misalnya), maka Anda dapat melakukannya dengan cara ini:

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

terima kasih, menggunakan ReDim arr (0 To 0) dan kemudian mengalokasikan elemen berikutnya bekerja untuk saya
Vasile Surdu

1

Jika rentang Anda adalah vektor tunggal, dan, jika dalam satu kolom, jumlah baris kurang dari 16.384, Anda dapat menggunakan kode berikut:

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

Terima kasih. Melakukan hal yang sama dengan 2 fungsi jika dapat membantu noobs lain seperti saya:

Koleksi

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

Array 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

Pemakaian

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
Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.