Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Объединение данных из строк и столбцов с соблюдением условия
 
Добрый день!
Стоит передо мной нетривиальная задача, которую я очень долго пытаюсь решить
Дано: таблица со множеством значений (порядка 20 тыс строк)
В примере исходной таблицы, в столбце "b" Названия организаций, далее в столбцах контактные данные. В некоторых организациях есть по несколько контактных лиц, причем контактные лица принадлежащие одной организации указаны без повторения названия организации.(указана пустая ячейка)

Можно ли сделать (видимо с помощью макроса) что-то похожее на вторую таблицу, где создается новая ячейка в строке где есть название, в которой объединяются все контактные лица с контактными данными из последующих строк, где указана пустая ячейка в столбце "B"  с последующим удалением таких строк?
 
С помощью PowerQuery
 

кодом

Код
Sub conc()
Dim mass()
d = ", должность - "
t = ", т: "
m = ", м: "
e = ", e-mail: "
For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 2).Value <> "" Then
        a = a + 1
        ReDim Preserve mass(1 To 8, 1 To a)
        mass(1, a) = Cells(i, 1).Value: mass(2, a) = Cells(i, 2).Value
        mass(3, a) = Cells(i, 3).Value: mass(4, a) = Cells(i, 4).Value
        mass(5, a) = Cells(i, 5).Value: mass(6, a) = Cells(i, 6).Value
        mass(7, a) = Cells(i, 7).Value
        mass(8, a) = mass(3, a) & d & mass(4, a) & t & mass(5, a) & m & mass(6, a) & e & mass(7, a)
    Else
        mass(8, a) = mass(8, a) & Chr(10) & Cells(i, 3).Value & d & Cells(i, 4).Value & t & Cells(i, 5).Value & m & Cells(i, 6).Value & e & Cells(i, 7).Value
    End If
Next
Worksheets.Add
Range("A2").Resize(a, 8)= Application.Transpose(mass)
End Sub



Изменено: yozhik - 3 Апр 2018 15:38:25
 
К сожалению надстройки PowerQuery на работе нет :( (Office 2010)
А макрос тоже выдает ошибку. А если упростить задачу:

Как макросом добиться, чтобы значение3, значение4, значение5 оказались в одной ячейке(D5). при этом строки 6. 7 удалились. и далее  значение6, значение7 в ячейке D8. строка 9 удалена и т.д по 20 тыс строкам
Изменено: dekhta - 11 Апр 2018 14:10:07
 
Не уверен, что при 20тыс строк удалять строки хорошая идея..
Что за ошибку выдает код?  
 
Цитата
dekhta написал:
К сожалению надстройки PowerQuery на работе нет  (Office 2010)
надстройка бесплатная и официальная. как раз с версии 2010 доступна.
 
Да, я дома попробую, на работе нет возможности установить.
Спасибо за совет
А через какую именно функцию можно добиться требуемого эффекта?
 
Цитата
yozhik написал: Не уверен, что при 20тыс строк удалять строки хорошая идея..
Как раз таки мне нужно уменьшить количество строк. А почему плохая идея? - Большой массив для обработки?
Именно поэтому я исключил все что можно объединить через СЦЕПИТЬ. Осталось только значения из ячеек перенести объединить в одну.

Цитата
yozhik написал: Что за ошибку выдает код?
Код
Worksheets.Add
Range("A2").Resize(a, 8) = Application.Transpose(mass)
End Sub
 
Цитата
dekhta написал:
А через какую именно функцию можно добиться требуемого эффекта?
в сообщении #2 я приложил файл с полным решением, там полный код.
 
Видно без надстройки я не вижу этого :) Спасибо, изучу позже вариант
 
накопировал более 20 тыс строк, секунд за 5 макрос справился, ошибки нет. Что пишет если Debug нажать? А и на всякий случай - код надо в стандартный модуль поместить, не в модуль листа
Изменено: yozhik - 3 Апр 2018 17:29:00
 
yozhik, Странное дело. Если пробовать на моем же примере - макрос работает как нужно, но если подставить реальные данные, почему-то нет.
Я даже не могу понять в чем разница. Это может зависеть от формата данных, или форматирования всей таблицы?
Изменено: dekhta - 4 Апр 2018 09:23:24 (удалено вложение)
 
Может у Вас в реальном файле прописаны какие то автособытия, или еще что-то, не знаю)  Если Вам просто разово надо почистить базу, самое простое - вместо worksheets.add напишите workbooks.add  Получите Ваши данные в сокращенном виде в новой книге, потом скопируете в старую, операция, я так понимаю, разовая)  
 
Если не получится, кусок(2-3строчки) реальных данных можете через личку отправить, думаю, разберемся в чем дело) макрос собирает только значения, формат/форматирование не должно никак учитываться
 
yozhik,  Я так и не понял как можно вложить файл в личное сообщение. Выложу его тут (изменил реальные имена и контакты)
3 вкладки - на первой данные где макрос не работает. на второй - работает. а на третьей - таблица с еще одним столбцом "регион" (добавил его первым), для этого в макросе нужно внести изменение в одном параметре?
вместо
Код
  If Cells(i, 2).Value <> "" Then
Нужно
Код
  If Cells(i, 3).Value <> "" Then
 
Уважаемые форумчане!
Подскажите, Почему макрос в одном случает выполняет свою задачу, а во втором нет. (Два примера на разных вкладках)
Структура данных одинакова
 
dekhta, посмотрите личные сообщения, я вчера или позавчера Вам написал, как исправить. Не стал тему поднимать, поздно Ваш вопрос увидел.
Ошибка в Application.Transpose(mass) из-за длины более 255 символов элемента массива
 
yozhik, Спасибо больше. Я не увидел входящее сообщение!
Страницы: 1
Читают тему (гостей: 1)
Наверх