Функция ArraySwapColumns позволяет переставить в нужном порядке столбцы двумерного массива.
Кроме того, попутно можно изменить вторую размерность массива (чтобы убрать лишние столбцы, или добавить недостающие)
См. пример использования в прикреплённом файле.
Function ArraySwapColumns(ByVal arr As Variant, ByVal NewColumnsOrder$, _ Optional ByVal OptionBase As Integer = 1) As Variant ' функция принимает в качестве параметра двумерный массив arr ' (для перестановки столбцов) ' и текстовую строку NewColumnsOrder с новым порядком столбцов ' в формате ",,5,6,8,,9-15,18,2,9-11,,1,4,,21," On Error Resume Next ColumnsArray = ParseColumnsString(NewColumnsOrder$) NewUBound% = UBound(ColumnsArray) + 1 ReDim tmpArr(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To NewUBound%) For j = LBound(ColumnsArray) To UBound(ColumnsArray) OldColumn% = ColumnsArray(j) + 1 - OptionBase NewColumn% = j + LBound(arr, 2) If OldColumn% >= 0 Then For i = LBound(arr, 1) To UBound(arr, 1) ' перенос столбца tmpArr(i, NewColumn%) = arr(i, OldColumn%) Next i End If Next j ArraySwapColumns = tmpArr End Function Function ParseColumnsString(ByVal txt$) As Variant ' Принимает в качестве параметра строку типа ",,5,6,8,,9-15,18,2,11-9,,1,4,,21," ' Возвращает одномерный (горизонтальный) массив в формате ' array(-1,-1,5,6,8,-1,9,10,11,12,13,14,15,18,2,11,10,9,-1,1,4,-1,21,-1) ' (пустые значения заменяются на -1; диапазоны типа 9-15 и 17-13 раскрываются) arr = Split(Replace(txt$, " ", ""), ","): Dim n As Long: ReDim tmpArr(0 To 0) For i = LBound(arr) To UBound(arr) Select Case True Case arr(i) = "", Val(arr(i)) < 0 tmpArr(UBound(tmpArr)) = -1: ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1) Case IsNumeric(arr(i)) tmpArr(UBound(tmpArr)) = arr(i): ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1) Case arr(i) Like "*#-#*" spl = Split(arr(i), "-") If UBound(spl) = 1 Then If IsNumeric(spl(0)) And IsNumeric(spl(1)) Then For j = Val(spl(0)) To Val(spl(1)) Step IIf(Val(spl(0)) > Val(spl(1)), -1, 1) tmpArr(UBound(tmpArr)) = j: ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1) Next j End If End If End Select Next i On Error Resume Next: ReDim Preserve tmpArr(0 To UBound(tmpArr) - 1) ParseColumnsString = tmpArr End Function
--------------------- добавлено позже ----------------------
То же самое, но в виде одной функции:
Function SWAP(ByVal arr As Variant, ByVal NewColumnsOrder$) As Variant ' Функция принимает в качестве параметра двумерный массив arr (для перестановки столбцов) ' и текстовую строку NewColumnsOrder с новым порядком столбцов в формате ",,5,6,8,,9-15,18,2,9-11,,1,4,,21," ' Возвращает массив, в котором столбцы переставлены в нужном порядке On Error Resume Next cols = Split(Replace(NewColumnsOrder$, " ", ""), ","): Dim n As Long: ReDim colArr(0 To 0) For i = LBound(cols) To UBound(cols) Select Case True Case cols(i) = "", Val(cols(i)) < 0 colArr(UBound(colArr)) = -1: ReDim Preserve colArr(0 To UBound(colArr) + 1) Case IsNumeric(cols(i)) colArr(UBound(colArr)) = cols(i): ReDim Preserve colArr(0 To UBound(colArr) + 1) Case cols(i) Like "*#-#*" spl = Split(cols(i), "-") If UBound(spl) = 1 Then If IsNumeric(spl(0)) And IsNumeric(spl(1)) Then For j = Val(spl(0)) To Val(spl(1)) Step IIf(Val(spl(0)) > Val(spl(1)), -1, 1) colArr(UBound(colArr)) = j: ReDim Preserve colArr(0 To UBound(colArr) + 1) Next j End If End If End Select Next i ReDim Preserve colArr(0 To UBound(colArr) - 1) ColumnsArray = colArr ReDim tmpArr(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To UBound(ColumnsArray) + 1) For j = LBound(ColumnsArray) To UBound(ColumnsArray) If Val(ColumnsArray(j)) >= 0 Then For i = LBound(arr, 1) To UBound(arr, 1): tmpArr(i, j + LBound(arr, 2)) = arr(i, Val(ColumnsArray(j))): Next i End If Next j SWAP = tmpArr End Function
Пример использования (для перeстановки столбцов на листе Excel)
Range("k1:o30").Value = SWAP(Range("a1:h30").Value, "2,5,1,,8")
Комментарии
Потому что в VBA это не обязательно. И на работе кода не сказывается.
Почему переменные не объявлены?
Никита, для этих целей я использую функцию объединения двумерных массивов:
http://excelvba.ru/code/CombineArrays
Добрый день!
Каким образом добавить полученный массив в конец к уже существующему?
Спасибо, теперь разобрался.
Обратите внимание на последнюю строку в макросе - примере использования:
Range("g1") - это ячейка, начиная с которой, будет вставлен новый массив на лист
А каким образом изменить диапазон для размещения переставленной матрицы ?
Отправить комментарий