Главная » Макросы для Excel » Разбиение строк двумерного массива - по одной строке для каждого значения

Разбиение строк двумерного массива - по одной строке для каждого значения
Результат преобразования массива функцией ExtendArray

Если у вас есть таблица Excel, в которой, в определённом столбце, через запятую перечислены значения (или диапазоны значений), а вы хотите получить аналогичную таблицу, но чтобы в каждой строке было только одно значение, - то вам на помощь придёт функция ExtendArray.

(пример работы функции можно увидеть на прикреплённом изображении)

В своей работе ExtendArray использует функцию ArrayOfValues и функцию TransposeArray
(которые надо также добавить в код, чтобы функция работала)

Function ExtendArray(ByVal arr, ByVal ColumnForExtend As Long) As Variant
    ' принимает в качестве параметров:
    ' двумерный массив arr, и номер столбца ColumnForExtend, содержащего список значений
    ' Возвращает двумерный массив (возможно, с большим количеством строк),
    ' в котором все строки содержат в столбце ColumnForExtend только одно значение
    ' индексы всех массивов начинаются с единицы (Option Base 1)

    ColumnsCount% = UBound(arr, 2) - LBound(arr, 2) + 1
    If ColumnForExtend > ColumnsCount% Or ColumnForExtend < 1 Then
        MsgBox "В массиве нет столбца с номером " & ColumnForExtend, vbCritical, "Ошибка": End
    End If
 
    ' формируем временный столбец из 1 столбца
    ReDim tmpArr(1 To ColumnsCount%, 1 To 1)
 
    For i = LBound(arr) To UBound(arr)    ' перебираем все строки исходного массива
        ' перебираем все значения в заданном столбце
        For Each v In ArrayOfValues(arr(i, ColumnForExtend))
            ' формируем новую запись (столбец) во временном массиве
            For j = LBound(arr, 2) To UBound(arr, 2)
                tmpArr(j, UBound(tmpArr, 2)) = arr(i, j)
            Next j
            ' вместо списка значений поставляем очередное значение
            tmpArr(ColumnForExtend, UBound(tmpArr, 2)) = v
            ' добавляем дополнительный столбец к временному массиву
            ReDim Preserve tmpArr(1 To ColumnsCount%, 1 To UBound(tmpArr, 2) + 1)
        Next v
    Next i
    ' удаляем лишний столбец
    On Error Resume Next: ReDim Preserve tmpArr(1 To ColumnsCount%, 1 To UBound(tmpArr, 2) - 1)
    ' транспонируем временный массив, и возвращаем результат
    ExtendArray = TransposeArray(tmpArr)
End Function

Функция нашла применение в программе выгрузки тарифов в XML - там вы можете посмотреть её в работе.

Вложения:
ExtendArray.xls34.5 КБ
  • 26808 просмотров

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".
Олег, 15 Янв 2018 - 10:03.#1

Таблица совсем простая. В первом столбце перечислены числовые коды, а во втором текстовые значения, разделённые пробелом. Всё как у вас, только не через запятую. Заменить пробел на запятую не вопрос, но текстовые значения макрос удаляет.
В принципе сделал ручками, но на будущее хотелось бы автоматизировать. Скорее всего придётся ещё несколько раз делать подобную процедуру. Ваш макрос подходит идеально, вот только текст не хочет понимать :(

Игорь (администратор сайта), 15 Янв 2018 - 00:57.#2

Олег, не видя вашу таблицу, ничего не могу подсказать.
Могу переделать макрос под заказ (платно). По бесплатным макросам, техподдержка не предоставляется.

Олег, 14 Янв 2018 - 19:56.#3

Здравствуйте!
Столкнулся с похожей проблемой, только во втором столбце перечислены не цифровые значения, а текстовые.
Задача та же - получить аналогичную таблицу, но чтобы в каждой строке было только одно значение.
Попробовал вашу табличку с макросом - с цифрами работает, текст просто удаляет.
Подскажите, как поменять макрос, чтобы работал и с текстом.

Сергей, 15 Фев 2015 - 10:14.#4

Спасибо. Так и сделаю.

P.S. Многими функциями для работы с массивами с Вашего сайт уже вопользовался. Спасибо за проделанную работу.

Игорь (администратор сайта), 13 Фев 2015 - 22:48.#5

Самый простой способ - запустить макрос 3 раза подряд, с разным параметром «номер столбца»
Можно, конечно, и макрос полностью переделать, - но не вижу в этом смысла (ненамного быстрее будет)

Сергей, 13 Фев 2015 - 20:20.#6

Добрый день.
Красивое решение. А если нужно сделать такое для нескольких столбцов? То есть для одной строки, есть, например, 3 столбца, в которых надо разбить значения и получить из всез комбинаций. Как бы Вы сделали - вызывали бы Вашу программу несколько раз (последовательно для всех столбцов) или подумали над усовершенствованием алгоритма?

sel, 29 Ноя 2011 - 10:53.#7

Извиняюсь за свою некомпетентность в экселе....
Благодарю за помошь...)

Игорь (администратор сайта), 29 Ноя 2011 - 10:47.#8

Я ж вам дал ссылку на готовую функцию, и показал пример, как её использовать.

Что ещё-то от меня нужно?

Сделать пример в виде файла, и показать, как это всё работает?

Да пожалуйста:

Ссылка на скачивание примера

sel, 29 Ноя 2011 - 10:38.#9

"Непонятно также, почему в примере у вас в качестве результата указана строка"
это не строка а данные в ячейке)
это похоже с вашим примером, но сначало у меня такой вид...

ООО "Рога1" 1
ООО "Рога1" 2
ООО "Рога1" 3
ООО "Рога1" 4
ООО "Рога1" 5
ООО "Рога1" 6
ООО "Рога1" 7
ООО "Рога1" 8
ООО "Рога1" 9
ООО "Копыта1" 1
ООО "Копыта1" 2
ООО "Копыта1" 3
ООО "Рога2" 1
ООО "Рога2" 2
ООО "Рога2" 3
ООО "Рога2" 4
ООО "Рога2" 5
ООО "Рога2" 6
ООО "Рога2" 7
ООО "Копыта2" 1
ООО "Копыта2" 2
ООО "Копыта2" 3
ООО "Копыта2" 4
ООО "Копыта2" 5

и из него бы создавалось

ООО "Рога1" 1, 2, 3, 4, 5, 6, 7, 8, 9
ООО "Копыта1" 1, 2, 3
ООО "Рога2" 1, 2, 3, 4, 5, 6, 7
ООО "Копыта2" 1, 2, 3, 4, 5

Игорь (администратор сайта), 29 Ноя 2011 - 04:24.#10

Тогда сначала примените функцию объединения массива (с уникальными значениями в первом столбце)

Варианты её использования:

  ' считываем массив с листа - в него попадут все заполненные строки
   Массив = Range([A1], Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
 
    ' объединяем уникальные, суммируя данные в столбце 2
   arr = JoinedArray(Массив, 1, "2")

или

  ' считываем массив с листа - в него попадут все заполненные строки
   Массив = Range([A1], Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
 
    ' объединяем уникальные, объединяя через запятую значения в столбце 2
   arr = JoinedArray(Массив, 1, ,"2")

Какой из вариантов вам выбрать - не знаю (поскольку вам и суммировать надо, и через запятую соединять)

Непонятно также, почему в примере у вас в качестве результата указана строка

66 |66, 23, 8д

По идее (судя по первому примеру), должно быть так:

66 |89, 8д

В любом случае, готового решения вы не найдёте, - придётся дорабатывать функцию, если нужно и суммирование, и объединение.

sel, 28 Ноя 2011 - 19:25.#11

точнее сказать мне нужно соединять диапазоны ячеек с данными
типа:
1 |33
1 |7
5 |89
45 |о5
45 |ф78
66 |66
66 |23
66 |8д

а делало
1 |33,7
5 |89
45 |о5, ф78
66 |66, 23, 8д

Игорь (администратор сайта), 28 Ноя 2011 - 18:08.#12

Воспользуйтесь функцией преобразования диапазона ячеек в текст

sel, 28 Ноя 2011 - 15:35.#13

Здравствуйте! а как можно наоборот зделать макросом? чтоб значения ячеек вставали в строчку, через запятую....

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
         ___     ___    ____    _           
  ____  / _ \   / _ \  | __ )  | |      ____
 |_  / | (_) | | (_) | |  _ \  | |     |_  /
  / /   \__, |  \__, | | |_) | | |___   / / 
 /___|    /_/     /_/  |____/  |_____| /___|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.