макрос excel который объединит данные с одинак.хар-ми

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » макрос excel который объединит данные с одинак.хар-ми (Макросы/Sub)

AdMiN7675

Дата: Вторник, 07.02.2023, 13:24 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

помогите написать макрос excel который поможет объединить данные разных строк с одинаковым ID в одну строку
во вложении 2 таблицы - одна исходник , а вторая как должно быть

К сообщению приложен файл: __1.xlsx (6.4 Kb)

Сообщение отредактировал AdMiN7675 - Вторник, 07.02.2023, 13:26

Ответить

Nic70y

Дата: Вторник, 07.02.2023, 14:01 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 8759

Репутация: 2272 ±

Замечаний: 0% ±

Excel 2010

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]

К сообщению приложен файл: _1.xlsm (21.2 Kb)

ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Вторник, 07.02.2023, 14:56

Ответить

AdMiN7675

Дата: Вторник, 07.02.2023, 15:39 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Nic70y, данные не всегда идут по порядку, но отсортировать руками это не проблема. Спасибо большое, сейчас попробую реализовать то что вы написали.

Ответить

AdMiN7675

Дата: Вторник, 07.02.2023, 17:04 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Nic70y, пробую чтобы данные с одинаковыми ID выводились в 1 ячейку, но почему то в последней строчке вывод неверный

[vba]

Код

If c <> "" And c = Range("a" & b + 1) Then
Range("c" & b) = Range("c" & b) & " " & Range("d" & b)& " " & Range("e" & b ) & Chr(10) & Range("c" & b+1) & " " & Range("d" & b+1) & "" & Range("e" & b+1 )
Range("c" & b & ":e" & b).WrapText = False
End If

[/vba]

Сообщение отредактировал AdMiN7675 - Вторник, 07.02.2023, 17:17

Ответить

Nic70y

Дата: Вторник, 07.02.2023, 17:14 | Сообщение № 5

Группа: Друзья

Ранг: Экселист

Сообщений: 8759

Репутация: 2272 ±

Замечаний: 0% ±

Excel 2010

[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

[/vba]

ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Вторник, 07.02.2023, 17:20

Ответить

AdMiN7675

Дата: Вторник, 07.02.2023, 18:31 | Сообщение № 6

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Nic70y, спасибо все отлично! немного доработала и получилось то что нужно!

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » макрос excel который объединит данные с одинак.хар-ми (Макросы/Sub)

Страница 1 из 1
1