Как объединить два массива в VBA?
Для таких, как я, которые искали атрибуты эллипса для преобразования пути:
const ellipseAttrsToPath = (rx,cx,ry,cy) =>
`M${cx-rx},${cy}a${rx},${ry} 0 1,0 ${rx*2},0a${rx},${ry} 0 1,0 -${rx*2},0`
3 ответа
К сожалению, тип Array в VB6 не обладал всем таким количеством функций razzmatazz. Вам придется просто перебирать массивы и вставлять их вручную в третий
Предполагая, что оба массива имеют одинаковую длину
Dim arr1() As Variant
Dim arr2() As Variant
Dim arr3() As Variant
arr1() = Array("A", 1, "B", 2)
arr2() = Array("C", 3, "D", 4)
ReDim arr3(UBound(arr1) + UBound(arr2) + 1)
Dim i As Integer
For i = 0 To UBound(arr1)
arr3(i * 2) = arr1(i)
arr3(i * 2 + 1) = arr2(i)
Next i
Обновлено: исправлен код. Извините за предыдущую версию с ошибками. Мне потребовалось несколько минут, чтобы получить доступ к компилятору VB6, чтобы проверить это.
Или даже способ, которым или переменная может быть неинициализированной или пустой массив или массив объектов (например, объектов Словаря). Только дескрипторы один размер за один раз, все же. Кроме того, это ДОБАВЛЯЕТ arr2 к arr1, а не слияниям.
Function appendArray(ByVal arr1 As Variant, ByVal arr2 As Variant) As Variant
Dim holdarr As Variant
Dim ub1 As Long
Dim ub2 As Long
Dim i As Long
Dim newind As Long
' Allows for one or both variants to not be arrays
If IsEmpty(arr1) Or Not IsArray(arr1) Then
arr1 = Array()
End If
If IsEmpty(arr2) Or Not IsArray(arr2) Then
arr2 = Array()
End If
' Now we assume we DO have two ARRAYS, even if one or the other
' has no elements
ub1 = UBound(arr1)
ub2 = UBound(arr2)
If ub1 = -1 Then
appendArray = arr2
Exit Function
End If
If ub2 = -1 Then
appendArray = arr1
Exit Function
End If
' Copy the first array. We know it is not empty.
holdarr = arr1
' Grow it to the final size we need, keeping the current contents
ReDim Preserve holdarr(ub1 + ub2 + 1)
' Set the starting new index
newind = UBound(arr1) + 1
' Append the second array, allowing that it might be an array of objects
For i = 0 To ub2
If VarType(arr2(i)) = vbObject Then
Set holdarr(newind) = arr2(i)
Else
holdarr(newind) = arr2(i)
End If
newind = newind + 1
Next i
' Return the appended array
appendArray = holdarr
End Function
Эта функция сделайте так, как предложил JohnFx, и учитывайте различную длину массивов
Function mergeArrays(ByVal arr1 As Variant, ByVal arr2 As Variant) As Variant
Dim holdarr As Variant
Dim ub1 As Long
Dim ub2 As Long
Dim bi As Long
Dim i As Long
Dim newind As Long
ub1 = UBound(arr1) + 1
ub2 = UBound(arr2) + 1
bi = IIf(ub1 >= ub2, ub1, ub2)
ReDim holdarr(ub1 + ub2 - 1)
For i = 0 To bi
If i < ub1 Then
holdarr(newind) = arr1(i)
newind = newind + 1
End If
If i < ub2 Then
holdarr(newind) = arr2(i)
newind = newind + 1
End If
Next i
mergeArrays = holdarr
End Function