格式化数据：从列到行答案

【问题标题】：Formatting Data: Columns to Rows格式化数据：从列到行
【发布时间】：2013-12-23 20:28:02
【问题描述】：

我有一个大型数据集，由两列组成，行名重复但行值唯一。这是一个小例子：

我想将其转换为具有多列的几行。像这样：

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

【问题讨论】：

您是否需要使用宏来重复/将来执行此操作，或者这是一次性的事情，您只需要知道如何以不慢的方式完成？
感谢您的提问。我以后会反复这样做。
这是一个非常适合我的解决方案： Re：格式化数据 - 列到行您的示例看起来非常“干净”，每列总是 7 个值 A 值。这是一个足够好的“方法”吗？如果需要更“动态”，请使用：这是一个宏，用于将数据列合并到与 A 列匹配的一行。还有一个示例工作簿，您可以将数据放入并测试它。 sites.madrocketscientist.com/jerrybeaucaires-excelassistant/… 这是该站点上链接文件中的 Consolidate 宏。谢谢大家的帮助！
您的数据是否按照您最初的示例进行了预排序？
数据已预先排序。我在之前的评论中使用了该解决方案，它对数据很有效。

标签： excel vba

【解决方案1】：

试试这样的：

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

【讨论】：

非常感谢您的帮助。这是我运行上述宏时的结果： A 2 3 4 5 6 7 A B 8 9 10 11 12 13 14 C 15 16 17 18 19 20 21

【解决方案2】：

一个简单的解决方案是：

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("A2"), order1:=xlAscending, Header:=xlYes

应该是

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

【讨论】：

1.我不喜欢破坏资源。 2.我更喜欢使用Match（先订购数据）。
添加了数据顺序，没有数据破坏，只是从行到列转置然后清理。这符合他对请求输出的描述。我不喜欢依赖工作表函数并避免使用常量，除非在多个位置确实需要它们
非常适合这个例子。似乎无法让它与我的实际数据一起使用。我添加了一个更具体的数据示例。再次感谢您的帮助。
您的数据是否已制定？细胞在哪里分裂？ A*01:01 是类别，24575.73 这是数据吗？
你能解释一下“似乎无法让它工作”的意思吗，因为当我用你的数据进行测试时，它仍然可以正常工作？或者提供一个指向更大数据集的链接，以便我可以对此进行测试。

【解决方案3】：

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

它适用于

A&B 列与此行 X = Range([a1], Cells(Rows.Count, "B").End(xlUp))
转储到C1 与此行[c1].Resize(UBound(X, 1), UBound(X, 1)) = Y

代码

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

【讨论】：

很好的概念，假设数据集没有太大以至于内存消耗成为问题。
在 ~2,000 行上测试了你的方法与我的方法 CPU 使用率相似，但我的方法的内存消耗是 ~+1mb 而你的是 ~+ 70mb，这意味着如果他的数据集最大化 excel 2007 ~65将数据存储在内存中的 ,0000 行可能会成为这个概念的一个问题 +1，但可以肯定
这是在 excel 中处理大数据范围的久经考验的方法 - 内存不会有问题。感谢 Upvore :)

【解决方案4】：

这个解决方案稍微改编自here（另见this accepted answer）。如果您的源范围是 A1:B21（可以轻松扩展），并且您希望将新数据存储在 D1:L3 中，请使用以下公式：

对于 D1：=INDEX($A$1:$A$50,ROW()*7-6,1)

对于 E1：=INDEX($B$1:$B$50,ROW()*7-6,1)

对于 F1：=INDEX($B$1:$B$50,ROW()*7-5,1)

对于 G1：=INDEX($B$1:$B$50,ROW()*7-4,1)

... 第 1 行以此类推。然后根据需要从 D1:L1 向下复制。

这种方法的好处是它不使用 VBA。

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

【讨论】：

如果你稍微改变一下数据，它就不再起作用了。
感谢您提出的解决方案。但是，我的数据集非常大。
@Makah - 如果您更具体地说明“稍微更改数据”的含义，那将会很有用。如发布的那样，我无法理解您的评论。我能想到的可能的变化是：1）每个行名称有另一个数字（与本例中的 7 不同），但仍然是恒定的；这可以通过替换硬编码的 7 轻松解决。 2）每个行名称具有非常数的行值；答案中专门评论了这个案例。对于除此之外的其他“稍微改变”，VBA 解决方案可能也不起作用。