การเพิ่มองค์ประกอบท้ายของอาร์เรย์

ฉันต้องการเพิ่มค่าในตอนท้ายของอาร์เรย์ VBA ฉันจะทำสิ่งนี้ได้อย่างไร ฉันไม่สามารถหาตัวอย่างง่ายๆออนไลน์ได้ นี่คือรหัสจำลองบางส่วนที่แสดงสิ่งที่ฉันต้องการจะทำ

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

ลองใช้ [แก้ไข]:

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

ฉันแก้ไขปัญหาโดยใช้คอลเล็กชันและคัดลอกไปยังอาร์เรย์หลังจากนั้น

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

นี่คือวิธีที่ฉันทำโดยใช้ตัวแปร 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

หรือถ้าคุณต้องการอาร์เรย์ของ Variants (ตัวอย่างเช่นส่งผ่านไปยังคุณสมบัติเช่น Shapes.Range) คุณสามารถทำได้ด้วยวิธีนี้:

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

หากช่วงของคุณเป็นเวกเตอร์เดียวและหากอยู่ในคอลัมน์จำนวนแถวจะน้อยกว่า 16,384 คุณสามารถใช้รหัสต่อไปนี้:

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

ขอบคุณ. ทำแบบเดียวกันกับ 2 ฟังก์ชั่นถ้ามันสามารถช่วย noobs อื่น ๆ เช่นฉัน:

ชุด

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

อาร์เรย์ 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

การใช้

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

คำตอบอยู่ในการตอบรับที่ยอมรับใน (โดยไม่มีปัญหา ReDim):

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

ในประวัติย่อ:

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

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