Excel VBA – добавление элемента в конец массива

Я хотел бы добавить значение в конец массива 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 

Заранее спасибо.

Попробуйте [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 

Я решил проблему с помощью коллекции и скопировал ее потом в массив.

 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 

Если ваш диапазон – это один вектор, а если в столбце число строк меньше 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 Array:

 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 

Вот как я это делаю, используя переменную Variant (array):

 Dim a As Range Dim arr As Variant 'Just a Variant variable (ie 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 
  • Что делает ключевое слово Set в VBA?
  • Каков наиболее эффективный / быстрый способ циклического преобразования строк в VBA (excel)?
  • Удалить строку на основе ключа поиска VBA
  • Вызов VBA - API отображается в Excel
  • Внедрение String.Format () в VB6
  • Вызов метода библиотеки .net из vba
  • Удаление файла в VBA
  • Как добавить пользовательскую вкладку Ribbon с помощью VBA?
  • Скребок сети супермаркетов Аргентины
  • Удаление элементов в массиве, если элемент является определенным значением VBA
  • Макрос Excel - вставлять только непустые ячейки с одного листа на другой
  • Давайте будем гением компьютера.