1

У меня есть данные, как показано ниже в двух столбцах, и мне нужно расположить их по горизонтали в ряд для каждого человека.

Baker   17                              
Baker   37                              
Baker   28                              
Baker   49                              
Baker   27                              
Baker   44                              
Baker   47                              
Baker   32                              
Baker   29                              
Boley   13                              
Boley   46                              
Boley   10                              
Boley   35                              
Boley   32                              
Boley   49                              
Boley   18                              
Boley   47                              
Boley   22                              

Baker   17  37  28  49  27  44  47  32  29
Boley   13  46  10  35  32  49  18  47  22

Как я могу это сделать?

2 ответа2

5
  1. Составьте список всех уникальных записей из столбца A В этом примере это будет вопрос ввода двух имен. С большим набором данных вы можете скопировать этот столбец в целевое местоположение и просто использовать инструмент «Удалить дубликаты», чтобы сократить список.

  2. Справа от имени в вашем новом списке (шахта начинается с F1 , поэтому у меня есть следующее в G1), введите следующую формулу в виде формулы массива, нажав Ctrl+Shift+Enter:

    =IFERROR(INDEX($B$1:$B$18,SMALL(IF($A$1:$A$18=$F1,ROW($B$1:$B$18),""),COLUMN()-COLUMN($F1))),"")
    

Для справки A1:A18 - ваш исходный список имен, B1:B18 - их соответствующие номера, а F1 - имя "Бейкер" в вашей новой таблице. Заполните это вправо, насколько вам нравится. Затем заполните, чтобы заполнить таблицу.

ПРИМЕЧАНИЕ. Если исходные данные НЕ начинаются со строки 1 , используйте вместо этого следующую формулу, где A1 - верхняя левая ячейка исходных данных:

=IFERROR(INDEX($B$1:$B$18,SMALL(IF($A$1:$A$18=$F1,ROW($B$1:$B$18)-ROW($A$1)+1,""),COLUMN()-COLUMN($F1))),"")
2

Если есть только несколько имен, вы можете сделать следующее с клавиатуры:

  1. Сортировать список, если еще не отсортирован.
  2. Выберите числа против имени.
  3. Перейти к столбцу C первого ряда для имени
  4. Выберите «Редактировать», «Вставить специальные», «Транспонировать значения», «ОК».
  5. Удалить все, кроме первой строки имени
  6. Повторите шаги с 2 по 5 для всех остальных имен
  7. Удалить столбец B.

Если у вас много имен, вам понадобится решение VBA:

Option Explicit
Sub TransposeColB()

  Dim ColCrntNext As Integer       ' The next cell on the current row
  Dim ColNextLast As Integer       ' The last cell on the next row
  Dim Offset As Integer            ' Offset from first number on row to last
  Dim RowCrnt As Integer           ' Current row

  With Sheets("Sheet1")     ' !!!! Replace "Sheet1" with name of your sheet !!!!

    ' Sort entire sheet in case a partial tranpose has occurred.
    .Cells.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    RowCrnt = 1
    ' Identify first blank cell on row.  This ensures nothing is overwritten.
    ColCrntNext = .Cells(RowCrnt, Columns.Count).End(xlToLeft).Column + 1
    Do While True
      ' Check name on next row
      Select Case .Cells(RowCrnt + 1, "a").Value
        Case ""
          ' The next row has no name.  The transpose is complete.
          Exit Do
        Case .Cells(RowCrnt, "a").Value
          ' The next row has the same name as the current row.  Move its
          ' numbers to the current row.
          ' Find last used column on the next row
          ColNextLast = .Cells(RowCrnt + 1, _
                                          Columns.Count).End(xlToLeft).Column
          Offset = ColNextLast - 2        ' Offset from first number to last.
                                          ' Normally zero.
          ' Move numbers from next row to current
          .Range(.Cells(RowCrnt, ColCrntNext), _
                 .Cells(RowCrnt, ColCrntNext + Offset)).Value = _
          .Range(.Cells(RowCrnt + 1, 2), _
                 .Cells(RowCrnt + 1, 2 + Offset)).Value
          .Rows(RowCrnt + 1).EntireRow.Delete     ' Delete next row
          ColCrntNext = ColCrntNext + Offset + 1  ' Advance to first blank cell
        Case Else
          ' The next row is for a new name
          RowCrnt = RowCrnt + 1
          ' Identify first blank cell on row. This ensures
          ' nothing is overwritten.
          ColCrntNext = .Cells(RowCrnt, _
                                   Columns.Count).End(xlToLeft).Column + 1
      End Select
    Loop
  End With

End Sub

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