Объединение строк в двумерном массиве

Function JoinedArray(ByVal arr As Variant, ByVal ComparedColumn As Long, _
                     Optional ByVal ColumnsForSum As String, Optional ByVal ColumnsForJoin As String, _
                     Optional ByVal JoinSeparator As String = ", ") As Variant
    '     осуществляет объединение строк в массиве
    '     получает в качестве параметров исходный массив, и номер столбца ComparedColumn,
    '     по которому осуществляется сравнение строк
    '     ---------------------------------------------
    '     для совпадающих строк:
    '     - суммируются значения в столбцах, перечисленных через запятую в переменной ColumnsForSum
    '     - соединяются (через разделитель JoinSeparator) значения в столбцах,
    '       перечисленных через запятую в переменной ColumnsForJoin
    '     ---------------------------------------------
    '     функция возвращает новый массив (возможно, с меньшей размерностью по вертикали)

 
    On Error Resume Next
    If Not IsArray(arr) Then MsgBox "Это не массив!", vbCritical: Exit Function
    If ComparedColumn > UBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function
    If ComparedColumn < LBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function
 
    For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, ComparedColumn) <> "" Then
            For j = i + 1 To UBound(arr, 1)
                If arr(j, ComparedColumn) = arr(i, ComparedColumn) Then
                    ' для последующего удаления этой строки из массива
                    arr(j, ComparedColumn) = Empty    ' затираем значение в сравниваемом столбце

                    ' суммируем строки - результат в верхнюю строку
                    For Each col In Split(ColumnsForSum, ",")
                        nCol = Val(col)
                        If nCol > 0 And nCol <= UBound(arr, 2) And nCol <> ComparedColumn Then
                            arr(i, nCol) = Val(Replace(arr(i, nCol), ",", ".")) _
                                         + Val(Replace(arr(j, nCol), ",", "."))
                        End If
                    Next
 
                    ' сцепляем строки - результат в верхнюю строку
                    For Each col In Split(ColumnsForJoin, ",")
                        nCol = Val(col)
                        If nCol > 0 And nCol <= UBound(arr, 2) And nCol <> ComparedColumn Then
                            If Len(Trim(arr(j, nCol))) > 0 Then
                                arr(i, nCol) = Trim(arr(i, nCol)) & JoinSeparator & Trim(arr(j, nCol))
                            End If
                        End If
                    Next
                End If
            Next j
        End If
    Next i
 
    ' удаляем ненужные (пустые) строки
    Dim iCount As Long    ' кол-во непустых строк
    For i = LBound(arr) To UBound(arr)
        iCount = iCount - (arr(i, ComparedColumn) <> "")
    Next i
 
    ' формируем новый массив
    ReDim narr(LBound(arr, 1) To iCount + LBound(arr, 1) - 1, LBound(arr, 2) To UBound(arr, 2))
 
    iCount = LBound(narr)    ' счётчик записей
    For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, ComparedColumn) <> "" Then
            For j = LBound(arr, 2) To UBound(arr, 2)
                narr(iCount, j) = arr(i, j)
            Next j
            iCount = iCount + 1
        End If
    Next i
 
    JoinedArray = narr
End Function

Sub ПримерИспользования()
    ' отключаем обновление экрана
    Application.ScreenUpdating = False
    ' считываем массив с листа - в него попадут все заполненные строки
    Массив = Range([A1], Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
 
    ' объединяем уникальные, суммируя данные в столбцах 2 и 3
    arr = JoinedArray(Массив, 1, "2,3")
 
    Range("e:g").ClearContents    ' очистка содержимого столбцов E F G
    ' заносим массив на лист, начиная с ячейки e1
    Range("e1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub