Предлагаемый солютон ниже (на основе вашего тега VBA).
- создает двумерный массив из 3 отдельных массивов (как предложено Джесси)
- использует
Redim Preserve
для добавления четвертого набора данных "NewData" в двумерный массив "ArrayMaster"
- создает временный рабочий лист, выгружает "ArrayMaster" , сортирует по "Newdata" (в порядке возрастания) для создания отсортированного массива, "ArrayMaster2"
- удаляет рабочий лист
Excel очень эффективен при сортировке, поэтому этот метод предоставил простой и быстрый способ сортировки (или многоуровневой сортировки)
Вы можете использовать метод пузырьковой сортировки , если Excel не был доступен для дампа / сортировки листов
Option Base 1
Sub ComboArray()
Dim ws As Worksheet
Dim Array1()
Dim Birthday()
Dim ID()
Dim NewData()
Dim ArrayMaster()
Dim ArrayMaster2()
Dim lngRow As Long
Dim lngCalc As Long
Dim lngCheck As Long
Birthday = Array(1998, 1923, 1983, 1982, 1924, 1923, 1954)
Array1 = Array("John", "Christina", "Mary", "frediric", "Johnny", "billy", "mariah")
ID = Array(12312321, 1231231209, 123123, 234324, 23423, 2234234, 932423)
ReDim ArrayMaster(1 To UBound(Array1, 1), 1 To 3)
'Create 2D MasterArray
For lngRow = 1 To UBound(Array1, 1)
ArrayMaster(lngRow, 1) = Array1(lngRow)
ArrayMaster(lngRow, 2) = Birthday(lngRow)
ArrayMaster(lngRow, 3) = ID(lngRow)
Next
NewData = Array(1, 3, 5, 7, 2, 4, 6)
'Check if new field is longer than overall array
If UBound(NewData, 1) > UBound(ArrayMaster, 1) Then
lngCheck = MsgBox("New field exceeds current array size, proceeding will drop off excess records" & vbNewLine & "(Press Cancel to end code)", vbOKCancel, "Do you want to proceed?")
If lngCheck = vbCancel Then Exit Sub
End If
'Add NewData field
ReDim Preserve ArrayMaster(UBound(ArrayMaster, 1), UBound(ArrayMaster, 2) + 1)
For lngRow = 1 To UBound(NewData, 1)
ArrayMaster(lngRow, UBound(ArrayMaster, 2)) = NewData(lngRow)
Next
With Application
.ScreenUpdating = False
.DisplayAlerts = False
lngCalc = .Calculation
End With
'Create working sheet, dump MasterArray and sort by Newdata (position 4 = cell D1)
Set ws = Worksheets.Add
ws.[a1].Resize(UBound(ArrayMaster, 1), UBound(ArrayMaster, 2)).Value2 = ArrayMaster
ws.UsedRange.Sort ws.[d1], xlAscending
'Create our sorted array MasterArray2, now with NewData(1,2,3,4,5,6,7)
ArrayMaster2 = ws.[a1].Resize(UBound(ArrayMaster, 1), UBound(ArrayMaster, 2)).Value2
ws.Delete
'cleanup working sheet
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = lngCalc
End With
End Sub