Excel 格式化数据：从列到行

我有一个很大的数据集，由两列组成，列名称重复，但行值唯一。下面是一个小例子：

A   1
A   2
A   3
A   4
A   5
A   6
A   7
B   8
B   9
B   10
B   11
B   12
B   13
B   14
C   15
C   16
C   17
C   18
C   19
C   20
C   21

我想把它转换成几行和多列。像这样：

A   1   2   3   4   5   6   7
B   8   9   10  11  12  13  14
C   15  16  17  18  19  20  21

我试图录制一个宏，但当我单击B8时，我不知道如何让宏不仅选择B1:B7中的单元格范围，还选择B8:B14中的单元格范围。宏始终恢复为B1:7

以下是我的宏示例：

Sub Macro2()    
Range("B1:B7").Select
Selection.Copy
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

我在谷歌上做了大量搜索，并没有找到一个简单的答案。如果这是初步的，我道歉

谢谢你的帮助

我应该更具体地说明我的数据的外观。这里是一个例子，但我有更多的行为每一行名

A*01:01 24575.73
A*01:01 66.87
A*01:01 38.21
A*01:01 24532.88
A*01:01 2090.44
A*01:01 61.87
A*01:01 41.01
A*02:01 306.68
A*02:01 24.96
A*02:01 23182.25
A*02:01 28.23
A*02:01 54.94
A*02:01 39.87
A*02:01 22734.92
A*02:03 22.83
A*02:03 131.63
A*02:03 35.51
A*02:03 71.33
A*02:03 30.82
A*02:03 24.21
A*02:03 25.23

---

试试这样的东西：

Const DEST_COLUMN As Integer = 5

Sub ByMakah()
    Dim lastRow As Integer, rowIndex As Integer
    Dim name As String, value As String, destionationRow As Integer, destionationCol As Integer

    'Clear Area
    Range("E:AA").ClearContents

    lastRow = Range("A10000").End(xlUp).Row
    Range(Cells(1, 1), Cells(lastRow, 1)).Copy
    Cells(1, DEST_COLUMN).PasteSpecial

    Range(Cells(1, DEST_COLUMN), Cells(lastRow, DEST_COLUMN)).RemoveDuplicates Columns:=1, Header:=xlYes

    'Fill values
    For rowIndex = 2 To lastRow
        name = Cells(rowIndex, 1)
        value = Cells(rowIndex, 2)

        destionationRow = WorksheetFunction.Match(name, Columns(DEST_COLUMN), False)

        'Get lastCol
        destionationCol = Cells(destionationRow, 1000).End(xlToLeft).Column + 1
        Cells(destionationRow, destionationCol) = value
    Next rowIndex

End Sub

---

一个简单的解决办法是：

Sub transposer()
    Dim lcell As Range
    Dim c_row  As Integer
    Dim a_cell As String
    Dim c_col As Long
    Sheet1.Columns("A:B").Sort key1:=Sheet1.Range("A2"), order1:=xlAscending, Header:=xlYes
    For Each lcell In Sheet1.Range("$A$1", "$A$" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
       If a_cell <> lcell Then
           c_row = c_row + 1
           a_cell = lcell
           Sheet1.Cells(c_row, 3) = a_cell
           c_col = 4
       End If
       Sheet1.Cells(c_row, c_col) = Sheet1.Cells(lcell.Row, 2)
       c_col = c_col + 1
    Next lcell
    Sheet1.Range("A:B").EntireColumn.Delete
End Sub

应该是

Sheet1.Columns("A:B").Sort key1:=Sheet1.Range("A1"), order1:=xlAscending

---

这方面的解决方案略为改编自（另请参见）。 如果源范围为A1:B21（可以轻松扩展），并且希望新数据存储在D1:L3中，请使用以下公式：

对于D1:

=索引（$A$1:$A$50，行（）*7-6,1）

对于E1:

=索引（$B$1:$B$50，行（）*7-6,1）

F1:

=索引（$B$1:$B$50，行（）*7-5,1）

对于G1:

=索引（$B$1:$B$50，行（）*7-4,1）

。。。对于第1行，依此类推。 然后根据需要从D1:L1向下复制

这种方法的优点是它不使用VBA

---

缺点是它对每个字母使用固定数量的项目。如果这是可变的，我认为更复杂的公式可以完成这项工作，并且有一种使用VBA的明确方法。

此方法使用可变数组来快速执行转置

它对你有用

• 带有此行的A列和B列

  X=范围（[a1]，单元格（Rows.Count，“B”）.End（xlUp））

• 使用此行转储到

  C1

  [C1]。调整大小（UBound（X，1），UBound（X，1））=Y

代码

---

---

您是否需要使用宏来重复/在将来执行此操作，或者这是一次性操作，您只需要知道如何以不慢的方式执行即可？谢谢您的提问。这是一个对我来说非常有效的解决方案：重新：将数据列格式化为行您的示例看起来非常“干净”，每列始终有7个值a值。这是一个足够好的“方法”吗。如果需要更“动态”，请使用以下命令：这里有一个宏，用于将数据列合并到与a列匹配的一行中。还有一个示例工作簿，您可以将数据放入其中并进行测试。它是该站点上链接文件中的“合并”宏。谢谢大家的帮助！您的数据是否按照初始示例的暗示进行了预排序？数据是预排序的。我在之前的评论中使用了这个解决方案，它对数据非常有效。1。我不喜欢破坏资源。2.我更喜欢使用Match（先排序数据）。添加数据顺序无数据破坏只需将行转换为列，然后进行清理。这符合他对请求输出的描述。我不喜欢依赖工作表函数和避免常量，除非在多个位置中确实需要它们。这个示例非常好。似乎无法让它与我的实际数据一起工作。我添加了一个更具体的数据示例。再次感谢您的帮助。您的数据是否已制定？细胞在哪里分裂？

A*01:01

是类别，而

24575.73

是数据吗？你能解释一下“似乎无法让它工作”是什么意思吗？因为当我用你的数据进行测试时，它仍然工作得很好？或者建立一个链接到一个更大的数据集，这样我就可以进行测试了。非常感谢你的帮助。这是我在运行上述宏时得到的结果：A 2 3 4 5 6 7 A B 8 9 10 11 12 13 14 C 15 16 17 18 19 20 21如果您稍微更改数据，它将不再工作。感谢您提出的解决方案。然而，我的数据集相当大。@Makah-如果您能更具体地说明“稍微更改数据”的含义，那将非常有用。如前所述，我无法理解你的评论。我能想到的可能变化是：1）有另一个数字（不同于本例中的7），但仍然是常量，即每行名称的行值；这可以通过更换硬编码的7轻松解决。2） 每行名称具有非常量行数值；该案在答复中得到了具体评论。除此之外的其他“变化”，可能VBA解决方案也不会起作用。假设数据集不太大，内存消耗不会成为问题，这是一个很好的概念。在~2000行上测试了您的方法和我的方法CPU使用情况相似，但我的方法内存消耗是+1mb，而你的方法内存消耗是+70mb，这意味着如果他的数据集最大化了excel 2007~650000行将数据存储在内存中可能会成为该概念的一大问题，尽管这是一种经过验证的在excel中处理大数据范围的方法—内存不会有问题。用于Upvore的Thx:）

Sheet1.Columns("A:B").Sort key1:=Sheet1.Range("A1"), order1:=xlAscending

Sub ByeSwanny()
Dim X
Dim Y
Dim lngRow As Long
Dim lngCnt1 As Long
Dim lngCnt2 As Long

X = Range([a1], Cells(Rows.Count, "B").End(xlUp))
ReDim Y(1 To UBound(X, 1), 1 To UBound(X, 1))

Y(1, 1) = X(1, 1)
Y(1, 2) = X(1, 2)
lngCnt1 = 2
lngCnt2 = 1

For lngRow = 2 To UBound(X, 1)
If X(lngRow, 1) = X(lngRow - 1, 1) Then
lngCnt1 = lngCnt1 + 1
Y(lngCnt2, lngCnt1) = X(lngRow, 2)
Else
lngCnt1 = 2
lngCnt2 = lngCnt2 + 1
Y(lngCnt2, 1) = X(lngRow, 1)
Y(lngCnt2, 2) = X(lngRow, 2)
End If
Next lngRow

[c1].Resize(UBound(X, 1), UBound(X, 1)) = Y

End Sub