-1

Мне нужно объединить строки с тем же именем, сохраняя данные каждого столбца. Например, если у нас есть две строки с именем "Mr Bean" в первом столбце "Name", объедините данные каждого столбца, относящиеся к строкам с именем "Mr Bean", затем удалите вторую и третью строки, поместив все данные только первый ряд называется "Мистер Бин". Таким образом, мы должны иметь все данные, относящиеся к одному человеку в одной строке, а не в нескольких.

+-------------------------------------------------------+
| Column Name   Column 2   Column 3   Column 4 Column 5 |
| Mr Bean        2           3                          |
| Mr Bean                    2          3        5      |
| Mr X           3                      3               |
| Mr Y           2           4          1        3      |
+-------------------------------------------------------+

Желаемый результат:

+-------------------------------------------------------+
| Column Name  Column 2    Column 3   Column 4 Column 5 |
| Mr Bean        2         3, 2          3        5     |
| Mr X           3                       3              |
| Mr Y           2          4            1        3     |
+-------------------------------------------------------+

Мой файл Excel имеет около 4000 строк и 450 столбцов.

2 ответа2

0

Макрос может группировать числа только в столбце 2-5, если имя столбца (Mr Bean) расположено друг под другом. Как бы выглядел макрос, если бы ему приходилось выполнять ту же задачу, но г-н Бин расположен в случайном порядке: г-н Бин г-н Х г-н г Бин

0

Это должно делать то, что вы хотите, изменить, как вам нужно -

Sub combine()
Application.ScreenUpdating = False
Dim c As Range
Dim i As Integer

For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
Label:
If c = c.Offset(1) And c <> "" Then
       For i = 1 To 4
            If c.Offset(1, i) <> "" Then
                If c.Offset(, i) = "" Then
                c.Offset(, i) = c.Offset(1, i)
                Else: c.Offset(, i) = c.Offset(, i) & "," & c.Offset(1, i)
                End If
            End If
       Next
       c.Offset(1).EntireRow.Delete
       GoTo Label
End If

Next
Application.ScreenUpdating = True
End Sub

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .