Как добавить содержимое нескольких строк в одну ячейку, группируя по третьей строке в Excel 2010

Я предлагаю решение, которое требует немного VBA.

В этом примере пример данных находится в B2: C10. Оставьте E1 в качестве ячейки заголовка, а в E2 поместите следующую формулу и нажмите CTRL + SHIFT + ENTER на панели формул, чтобы создать формулу массива. Формула теперь должна быть заключена в фигурные скобки, чтобы указать, что это формула массива.

=IFERROR(INDEX($B$2:$B$10, MATCH(0, COUNTIF(E$1:$E1, $B$2:$B$10), 0),1),"") 

Перетащите это вниз, пока не получите пробелы. Сначала создается список уникальных значений из группы на B2: B10. Обратите внимание, что куда бы вы ни поместили эту формулу, по крайней мере на одну ячейку над ней должна быть доступна ссылка. E1 в этом случае как формула начинается с E2.

Мы собираемся использовать функцию под названием TEXTJOIN. Однако в большинстве версий Excel это недоступно. Это может произойти, если вы используете Office 365 версию Excel 2016. Если эта функция недоступна, используйте ниже UDF (пользовательская функция) в VBA для репликации той же функциональности.

Нажмите ALT + F11 для доступа к VBA Editor. Вставьте модуль из меню вставки. Поместите в него следующий UDF.

Function TEXTJOIN1(delimiter As String, ignore_empty As Boolean, ParamArray cell_ar() As Variant) For Each cellrng In cell_ar For Each cell In cellrng If ignore_empty = False Then result = result & cell & delimiter Else If cell <> "" Then result = result & cell & delimiter End If End If Next cell Next cellrng TEXTJOIN1 = Left(result, Len(result) - Len(delimiter)) End Function 

Теперь вернемся к листу Excel, мы будем использовать эту функцию в качестве UDF в формуле. В F2 поместите следующую формулу и нажмите CTRL + SHIFT + ENTER, чтобы создать формулу массива.

=IFERROR(TEXTJOIN1(CHAR(10),TRUE,IF($B$2:$B$10=E2,$C$2:$C$10,"")),"") 

Перетащите его вниз до намеченных рядов. Подождите, это создаст список имен по группам, объединенным с помощью Char (10), но чтобы увидеть правильный эффект, вам нужно включить Wrap Text на нужные ячейки. Вы можете сделать это вручную с помощью параметра Формат ячеек в Excel или использовать этот простой макрос, чтобы сделать это за вас. Просто укажите диапазон в начале. В этом примере это E2: F4.

Нажмите ALT + F11 для доступа к VBA Editor. Вставьте модуль из меню вставки и вставьте в него следующий код. Это создает макрос с именем Format1

Sub Format1 ()

 Range("E2:F4").Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlTop .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub 

Вернуться в лист Excel Нажмите ALT + F8 для доступа к диалоговому окну Macro и запустите Format1.

Протестируйте это решение с вашей стороны и дайте мне знать в случае каких-либо проблем.

После публикации и перед тем, как увидеть другой ответ, я работал с коллегой, и мы получили его.

Начал с сортировки по группе, а затем по имени.

Затем мы добавили столбец, который проверял бы, было ли добавлено имя (есть дубликаты), и была ли группа одинаковой или разной. Если это имя еще не было добавлено, и это была все та же группа, оно добавило новое имя в список из ячейки выше, используя:

=IF(B2=B1,C1,IF(A2=A1,CONCATENATE(C1,CHAR(10),B2),B2)) 

В другом столбце мы создали текущий обратный счетчик имен в группе.

=IF(A2=A1,D1-1,COUNTIF(A:A,A2)) 

Который получил это:

Тогда мы просто отфильтровали столбец D по «1»:

Private Sub MergeDuplicates()   Dim Rng As Range, xCell As Range Dim xRows As Integer   xTitleId = "Merge Duplicates"  Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)  Application.ScreenUpdating = False Application.DisplayAlerts = False  xRows = WorkRng.Rows.count  For Each Rng In WorkRng.Columns For i = 1 To xRows - 1 For j = i + 1 To xRows If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then Exit For End If Next WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge i = j - 1  Next Next  Application.DisplayAlerts = True Application.ScreenUpdating = True  End Sub 

NB Вставьте этот код как модуль и вернитесь к листу, чтобы запустить его, выберите необходимый диапазон данных, когда появится INPUT BOX, и завершите, нажав Ok.