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

列到垂直列表

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

Answer 2

我猜您的真实数据比该列表长得多，所以这就是我在这种情况下要做的事情。

首先，将列表放在B列中，并添加一个公式，将“团队”复制到A列中：

*请注意，您必须将b2中的值复制并粘贴到a2中，然后在a3上启动公式。 在单元格a3中键入公式= IF（LEFT（B3,4）=“ Team”，B3，A2）并将其向下拖动（或向下移动控件，然后向下移动d控件）。这个公式在做什么？它查看B单元格，如果它以“ Team”开头，则使用该单元格的值，否则使用上面的单元格的值（将是另一个“ Team”）。

然后，复制并粘贴值A列，以免在后续步骤后失去公式结果：

过滤搜索词“ team”中的B列“ player”，并删除整行：

现在您拥有团队的A列，球员的B列，并在C列中使用此公式：= IF（A2 = A1，CONCATENATE（C1，“”，B2），CONCATENATE（A2，“”，B2）） 。 此公式将查看“团队”列，如果不同，它将启动一个新的团队和玩家链，否则将玩家添加到团队和玩家上方的链中。

我希望您可以遵循这里的逻辑并完成您想做的事情。让我知道怎么回事。