Excel - транспонировать строки (группы разного размера) в столбцы

Question

У меня есть некоторые данные Excel, которые теперь находятся в строках, и я хочу легко и эффективно поместить их в столбцы, и я не могу понять, как это сделать.Любой совет будет приветствоваться!Спасибо.

Пример: превратить вот это в Excel

Team A
John
Team B
Peter
John
Team C
John
Peter
Oliver
Anna
Team D
Anna

в:

Team A John
Team B Peter John
Team C John Peter Oliver Anna
Team D Anna

Answer 1

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

Сначала поместите список в столбец B и добавьте формулу, которая копирует команду в столбец A:

* обратите внимание, что вы должны скопировать и вставить значение из b2 в a2 и запустить формулу на a3. Введите формулу = IF (LEFT (B3,4) = "Team", B3, A2) в ячейке a3 и перетащите ее вниз (или управляйте смещением вниз, затем управляйте d, чтобы заполнить). Что делает эта формула? Он смотрит на ячейку B, если он начинается с «Team», он использует значение этой ячейки, в противном случае он использует значение ячейки выше (которая будет другой «Team»).

Затем скопируйте и вставьте столбец значений A, чтобы не потерять результаты формулы после следующих шагов:

Отфильтруйте столбец B "player" по поисковому запросу "team" и удалите все эти строки:

Теперь у вас есть столбец A команд, столбец B игроков и используйте эту формулу в столбце C: = IF (A2 = A1, CONCATENATE (C1, "", B2), CONCATENATE (A2, "", B2)) , Эта формула смотрит на столбец «Команда» и, если он отличается, запускает новую цепочку команды и игрока, в противном случае добавляет игрока в цепочку выше команды и игрока.

Я надеюсь, что вы можете следовать логике здесь и выполнить то, что вы пытаетесь сделать. Дайте мне знать, как это происходит.

Answer 2

Столбец в вертикальный список

Option Explicit

'*******************************************************************************
' Purpose:  Processes a one-column range containing groups of title-values data,
'           transposing the titles to the first column of a range and the values
'           to columns next to the title thus creating a vertical list.
'*******************************************************************************

Sub ColumnToVerticalList()

  Const cStrSheet As String = "Sheet1"  ' Worksheet Name
  Const cLngFirstRow As Long = 2        ' First Row of Source Data
  Const cStrColumn As String = "A"      ' Column of Source Data
  Const cStrSearch As String = "Team"   ' Search String
  Const cStrCell As String = "C2"       ' Target Cell

  Dim arrSource As Variant      ' Source Array
  Dim lngArr As Long            ' Source Array Row Counter

  Dim arrTarget As Variant      ' Target Array
  Dim lngRows As Long           ' Number of Rows (Counter) in Target Array
  Dim iCols As Integer          ' Number of Columns (Counter) in Target Array
  Dim iColsTemp As Integer      ' Target Array Columns Counter
  Dim strTargetRange As String  ' Target Range

  ' Paste the calculated source range into the source array - arrSource.
  With ThisWorkbook.Worksheets(cStrSheet)
    arrSource = .Range( _
        .Cells(cLngFirstRow, cStrColumn), _
        .Cells(.Cells(Rows.Count, cStrColumn).End(xlUp).Row, cStrColumn))
  End With

  ' Calculate the number of rows and columns of the target array - arrTarget.
  iColsTemp = 1
  For lngArr = LBound(arrSource) To UBound(arrSource)
    If InStr(1, arrSource(lngArr, 1), cStrSearch, vbTextCompare) <> 0 Then
      If iColsTemp > iCols Then
        iCols = iColsTemp
      End If
      iColsTemp = 1
      Debug.Print arrSource(lngArr, 1)
      lngRows = lngRows + 1
     Else
      iColsTemp = iColsTemp + 1
    End If
  Next

  ' Calculate the target range address.
  strTargetRange = Range(Cells(Range(cStrCell).Row, Range(cStrCell).Column), _
      Cells(Range(cStrCell).Row + lngRows - 1, _
      Range(cStrCell).Column + iCols - 1)).Address

  ' Resize the target array.
  ReDim arrTarget(1 To lngRows, 1 To iCols)

  ' Write data from source array to target array.
  lngRows = 0
  iCols = 1
  For lngArr = LBound(arrSource) To UBound(arrSource)
    If InStr(1, arrSource(lngArr, 1), cStrSearch, vbTextCompare) <> 0 Then
      iCols = 1
      lngRows = lngRows + 1
      arrTarget(lngRows, 1) = arrSource(lngArr, 1)
     Else
      iCols = iCols + 1
      arrTarget(lngRows, iCols) = arrSource(lngArr, 1)
    End If
  Next

  ' Paste data of the target array into the target range
  ThisWorkbook.Worksheets(cStrSheet).Range(strTargetRange) = arrTarget

End Sub