помогите написать макрос excel который поможет объединить данные разных строк с одинаковым ID в одну строку во вложении 2 таблицы - одна исходник , а вторая как должно быть
помогите написать макрос excel который поможет объединить данные разных строк с одинаковым ID в одну строку во вложении 2 таблицы - одна исходник , а вторая как должно бытьAdMiN7675
AdMiN7675, в реале данные так и идут по-порядку, как у вас в файле? если да, то как-то так: [vba]
Код
Sub u_11() Application.ScreenUpdating = False a = Cells(Rows.Count, "a").End(xlUp).Row For b = a To 1 Step -1 c = Range("a" & b).Value If c <> "" And c = Range("a" & b + 1) Then Range("c" & b) = Range("c" & b) & Chr(10) & Range("c" & b + 1) Range("d" & b) = Range("d" & b) & Chr(10) & Range("d" & b + 1) Range("e" & b) = Range("e" & b) & Chr(10) & Range("e" & b + 1) Range("c" & b & ":e" & b).WrapText = False End If Next Range("a1:e" & a).RemoveDuplicates Columns:=1, Header:=xlNo Application.ScreenUpdating = True End Sub
[/vba]
AdMiN7675, в реале данные так и идут по-порядку, как у вас в файле? если да, то как-то так: [vba]
Код
Sub u_11() Application.ScreenUpdating = False a = Cells(Rows.Count, "a").End(xlUp).Row For b = a To 1 Step -1 c = Range("a" & b).Value If c <> "" And c = Range("a" & b + 1) Then Range("c" & b) = Range("c" & b) & Chr(10) & Range("c" & b + 1) Range("d" & b) = Range("d" & b) & Chr(10) & Range("d" & b + 1) Range("e" & b) = Range("e" & b) & Chr(10) & Range("e" & b + 1) Range("c" & b & ":e" & b).WrapText = False End If Next Range("a1:e" & a).RemoveDuplicates Columns:=1, Header:=xlNo Application.ScreenUpdating = True End Sub
Nic70y, данные не всегда идут по порядку, но отсортировать руками это не проблема. Спасибо большое, сейчас попробую реализовать то что вы написали.
Nic70y, данные не всегда идут по порядку, но отсортировать руками это не проблема. Спасибо большое, сейчас попробую реализовать то что вы написали.AdMiN7675
Sub u_11() Application.ScreenUpdating = False a = Cells(Rows.Count, "a").End(xlUp).Row For b = a To 1 Step -1 c = Range("a" & b).Value Range("c" & b) = Range("c" & b) & " " & Range("d" & b) & " " & Range("e" & b) Range("d" & b & ":e" & b).Clear If c <> "" And c = Range("a" & b + 1) Then Range("c" & b) = Range("c" & b) & Chr(10) & Range("c" & b + 1) Range("c" & b).WrapText = False End If Next Range("a1:c" & a).RemoveDuplicates Columns:=1, Header:=xlNo Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Sub u_11() Application.ScreenUpdating = False a = Cells(Rows.Count, "a").End(xlUp).Row For b = a To 1 Step -1 c = Range("a" & b).Value Range("c" & b) = Range("c" & b) & " " & Range("d" & b) & " " & Range("e" & b) Range("d" & b & ":e" & b).Clear If c <> "" And c = Range("a" & b + 1) Then Range("c" & b) = Range("c" & b) & Chr(10) & Range("c" & b + 1) Range("c" & b).WrapText = False End If Next Range("a1:c" & a).RemoveDuplicates Columns:=1, Header:=xlNo Application.ScreenUpdating = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
