'словарь для массивов

Set DicArr = CreateObject("Scripting.Dictionary")

'DicArr.exists (strDate)

'цикл по временным массивам

For iArr = 1 To 9

'определяем столбец для массива

Select Case iArr

Case 1: iNbClnSource = 2 'Дата

Case 2: iNbClnSource = 3 'Тип

Case 3: iNbClnSource = 6 'Длит.

Case 4: iNbClnSource = 7 'Зона

Case 5: iNbClnSource = 9 'Конеч. размещ.

Case 6: iNbClnSource = 10 'Прич. остан.

Case 7: iNbClnSource = 12 'Комментарий

Case 8: iNbClnSource = 14 'Кнц

Case 9: iNbClnSource = 22 'Событие

End Select

'загрузка массива

'iNbClnSource + 1 'таблица начинается со второго столбца

aTemp = Range(.Cells(8, iNbClnSource + 1), .Cells(iNbRow, iNbClnSource + 1)).Value

'загрузка массива в словарь

DicArr.Add iArr, aTemp

Erase aTemp

Next iArr

Set DicArr = Nothing

'функция объединения массивов

aTemp = FnCombArr(DicArr)

'===========================================================================================

' ##### функция объединения по массивов столбцам

'принимает словарь равных массивов и собирает в один

'-------------------------------------------------------------------------------------------

Function FnCombArr(ByVal DicArr As Variant) As Variant

Dim aTempMain As Variant, aTemp As Variant

Dim iArr As Long

Dim i As Long

'если передан словарь

If TypeName(DicArr) = "Dictionary" Then

'определяем размер массива

aTemp = DicArr.Item(1)

ReDim aTempMain(1 To UBound(aTemp), 1 To DicArr.Count)

For iArr = 1 To DicArr.Count

aTemp = DicArr.Item(iArr)

jjj = TypeName(aTemp)

If IsArray(aTemp) Then

For i = LBound(aTempMain) To UBound(aTempMain)

aTempMain(i, iArr) = Trim(Application.Clean(aTemp(i, 1)))

Next i

End If

Erase aTemp

Next iArr

FnCombArr = aTempMain

Else

FnCombArr = ""

End If

End Function

'===========================================================================================