Thêm một phần tử vào cuối một mảng


14

Tôi muốn thêm một giá trị vào cuối mảng VBA. Tôi có thể làm cái này như thế nào? Tôi đã không thể tìm thấy một ví dụ đơn giản trực tuyến. Đây là một số mã giả cho thấy những gì tôi muốn có thể làm.

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

Là ý tưởng để thêm giá trị vào cuối của một mảng hiện có? Hoặc nó giống như ví dụ của bạn khi bạn chỉ muốn tải một phạm vi vào một mảng? Nếu sau này, tại sao không sử dụng một-liner arr = Range.Value?
Xuất sắc

Câu trả lời:


10

Hãy thử [EDITED]:

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

Cảm ơn nhưng thật không may, điều này không hoạt động, UBound(arr)yêu cầu arrđược khởi tạo với một số dimenstion, ví dụ Dim arr(1) As Variantsau đó ReDim Preservelà thất bại và nói rằng mảng đã được kích thước? với những từ khác bạn không thể làm lại một mảng trong VBA?
megloff


Vâng, ví dụ từ msdn cũng không hoạt động trong excel vba. cùng một lỗi, phàn nàn rằng mảng đã được đặt kích thước
megloff

Có vẻ như tôi nên sử dụng thay vì một mảng a Collectionvà chuyển đổi nó sau đó thành một mảng. Bất cứ một đề nghị nào khác?
megloff

2
Cảm ơn bạn nhưng nó vẫn không quan tâm theo cách này vì như đã đề cập trước đó, UBound(arr)yêu cầu một mảng đã có kích thước. Vâng, có vẻ như tôi phải sử dụng một bộ sưu tập thay thế. Dù sao cũng cảm ơn bạn
megloff

8

Tôi đã giải quyết vấn đề bằng cách sử dụng Bộ sưu tập và sao chép nó sau đó vào một mảng.

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
Nếu bạn sẽ sử dụng Bộ sưu tập, bạn cũng có thể sử dụng Đối tượng từ điển. `Đặt col = CreateObject (" Scripting.Dixi ")` Sau đó, bạn có thể xuất các Khóa trực tiếp dưới dạng một mảng và bỏ qua chức năng đã thêm của mình: `Array = col.keys` <= Array
B Hart

3

Đây là cách tôi thực hiện, sử dụng biến Variant (mảng):

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

Hoặc, nếu bạn thực sự cần một mảng Biến thể (để chuyển đến một thuộc tính như Shapes.Range chẳng hạn), thì bạn có thể thực hiện theo cách này:

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

cảm ơn, sử dụng mảng ReDim (0 đến 0) và sau đó phân bổ phần tử tiếp theo làm việc cho tôi
Vasile Surdu

1

Nếu phạm vi của bạn là một vectơ duy nhất và nếu trong một cột, số lượng hàng ít hơn 16.384, bạn có thể sử dụng mã sau:

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

Cám ơn. Làm tương tự với 2 chức năng nếu nó có thể giúp các noobs khác như tôi:

Bộ sưu tập

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

Mảng 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

Sử dụng

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

0

Câu trả lời là trong phản hồi được chấp nhận trong (không có vấn đề ReDim):

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

Trong hồ sơ:

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

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
Khi sử dụng trang web của chúng tôi, bạn xác nhận rằng bạn đã đọc và hiểu Chính sách cookieChính sách bảo mật của chúng tôi.
Licensed under cc by-sa 3.0 with attribution required.