mail mail
Нужен макрос для 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 КБ921 день 18 часов назад

Комментарии

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

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

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

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

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

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

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

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

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

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

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

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

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

ООО "Рога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

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

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

  ' считываем массив с листа - в него попадут все заполненные строки
   Массив = 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д

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

точнее сказать мне нужно соединять диапазоны ячеек с данными
типа:
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д

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

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

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

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

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