Функция для расширения массива

#excel #vba

#excel #vba

Вопрос:

Как мне написать функцию, в которую я могу передать массив и вернуть его, но расширить на 1?

например

 myArray = expandArray(myArray)

Function expandArray(myArray As Long)
    Dim x As Integer
    x = UBound(myArray)   1
    ReDim Preserve myArray(x)
    expandArray = myArray

End Function
 

Я получаю ошибку ByRef с приведенным выше

Комментарии:

1. что не так с вашим кодом? Вы получаете ошибки?

2. Я должен был сказать, я получаю ошибку ByRef

3. myArray As Long ожидает длинный, а не массив

4. определите myArray как вариант

5. Обратите внимание, что, хотя вы можете это сделать, это не очень эффективно. Например, если вы попытаетесь использовать это в большом цикле для создания массива элемент за элементом, производительность может заметно снизиться. Если вы действительно хотите такого поведения, возможно, было бы лучше использовать ArrayList (сам по себе не является частью VBA, но все же прост в использовании из VBA). Это разница между O(n) добавлением и (амортизированным) O(1) добавлением.

Ответ №1:

Заставьте myArray быть массивом и сделайте его типа Variant . Если вы уверены, что ваш массив содержит только значения типа Long , замените оба Variant на Long .

 Sub Test()
    Dim myOriginalArray()
    myOriginalArray = Array(1, 2, 3)

    Dim MyReturnedArray()
    MyReturnedArray = expandArray(myOriginalArray)
   
    'because of ByRef both myOriginalArray and MyReturnedArray got expanded
End Sub

Function expandArray(ByRef myArray() As Variant) As Variant
    Dim x As Long
    x = UBound(myArray)   1
    ReDim Preserve myArray(x)
    expandArray = myArray
End Function
 

Но обратите внимание, что вы можете указать только массив ByRef , что означает, что myOriginalArray он тоже будет расширен!

Поэтому было бы более понятно сделать это процедурой, а не функцией

 Sub Test()
    Dim myOriginalArray()
    myOriginalArray = Array(1, 2, 3)

    expandArray myOriginalArray 
    'the myOriginalArray got expanded because of ByRef
End Sub

Sub expandArray(ByRef myArray() As Variant)
    Dim x As Long
    x = UBound(myArray)   1
    ReDim Preserve myArray(x)
End Function
 

Или, если вам нужно myOriginalArray , чтобы не изменять,

 Sub Test()
    Dim myOriginalArray()
    myOriginalArray = Array(1, 2, 3)

    Dim MyReturnedArray()
    MyReturnedArray = expandArray(myOriginalArray)

    'here only MyReturnedArray is the expanded version
End Sub

Public Function expandArray(ByRef myArray() As Variant) As Variant
    Dim x As Long
    x = UBound(myArray)   1
    
    Dim ReturnArray() As Variant
    ReturnArray = myArray 'make sure only the return array gets expanded even with ByRef
    
    ReDim Preserve ReturnArray(x)
    expandArray = ReturnArray
End Function
 

Заключительные мысли

Обратите внимание, что если вы используете ReDim Preserve много, это сопряжено с высокими затратами и значительно замедляет работу вашего кода. Иногда более эффективно определить больший массив с пустыми ячейками, чем изменять размер массива несколько раз.

Комментарии:

1. Вышесказанное предполагает, LBound(array)=0 что это не всегда так.

2. Обычной практикой является удвоение емкости для каждого требуемого события изменения размера.

3. @JohnAlexiou Хорошие моменты! Нижняя граница может быть сохранена, если нет 0 : ReDim Preserve myArray(LBound(myArray) To UBound(myArray) 1)

Ответ №2:

Сначала посмотрите, будет ли Collection объект выполнять эту работу

 Public Sub TestCollection()

    Dim arr As New Collection
    
    arr.Add 100
    arr.Add 200
    arr.Add 300
    
    Debug.Print arr(1)
    ' 100
    
    Call arr.Remove(1)

    Debug.Print arr(1)
    ' 200
    
End Sub
 

Но то, что вы не можете сделать с коллекцией, — это записать в ячейки типа

 Sheet1.Range("A2").Resize(arr.Count, 1).Value2 = arr
' Error
 

Итак, если вам нужно расширить массив, используйте приведенный ниже код:

 Public Sub TestExpandArray()
    Dim arr1() As Variant, arr2 As Variant
    
    arr1 = Array(100, 200, 300)
    arr2 = ExpandArray1(arr1, 2)
    ' result is 5 array
    
    Dim i As Long
    For i = LBound(arr2, 1) To UBound(arr2, 1)
        Debug.Print i, arr2(i)
    Next i
    
    ' Now test a 2D array from a range. The size is 5×7 for example.
    arr1 = Sheet1.Range("A2").Resize(5, 7).Value2
    
    arr2 = ExpandArray2(arr1, 1, 3)
    ' result is 6×10 array
    Debug.Print UBound(arr2, 1), UBound(arr2, 2)

End Sub

Public Function ExpandArray1(ByRef arr() As Variant, ByVal count As Long) As Variant()
    Dim i1 As Long, i2 As Long, i3 As Long
    i1 = LBound(arr, 1): i2 = UBound(arr, 1)
    i3 = i2   count
    ReDim Preserve arr(i1 To i3)
    ExpandArray1 = arr
End Function

Public Function ExpandArray2(ByRef arr() As Variant, ByVal count1 As Long, ByVal count2 As Long) As Variant()
    Dim i1 As Long, i2 As Long, i3 As Long
    Dim j1 As Long, j2 As Long, j3 As Long
    i1 = LBound(arr, 1): i2 = UBound(arr, 1)
    j1 = LBound(arr, 2): j2 = UBound(arr, 2)
    i3 = i2   count1: j3 = j2   count2
    Dim res() As Variant
    ReDim res(i1 To i3, j1 To j3)
    For i3 = i1 To i2
        For j3 = j1 To j2
            res(i3, j3) = arr(i3, j3)
        Next j3
    Next i3
    ExpandArray2 = res
End Function
 

Как вы можете видеть, код ExpandArray1 для расширения одномерного массива может использовать Preserve ключевое слово, и это прямо вперед. Но код ExpandArray2 для расширения 2D-массива не может использоваться Preserve , и должно выполняться ручное копирование данных.