2

我有一个格式如下的 Excel 电子表格：

前

我一直在尝试做的是将其格式化为如下所示：

后

所以我猜这是一种转置（不知道如何称呼它）。

我花了最后一个半小时试图在 VBA 中做到这一点，但没有成功。

这只是它的格式示例，实际上大约有 50,000 个，所以我需要使用 VBA 或类似的东西来做。

有人能帮我解决这个问题吗？

4

4 回答 4

3

使用 Excel 2007，您不一定需要 VBA。在数据透视表向导（Alt+D，P）中选择“多个合并范围”，下一步，选择“我将创建页面字段”，下一步，选择您的数据，下一步，选择“新建工作表”，完成。双击数据透视表的底部 RH 单元格。过滤ColumnA并删除空白行，过滤ColumnB并删除包含“Type”的行。在“Row”和“Column”的右侧插入列并填充查找值。

于 2012-07-20T00:08:08.377 回答
1

如果您对 LOOKUP 并不完全满意并且范围数量可控，则可以使用一种替代方法，它有点乏味，但如果再次需要这种“转置”并且您忘记了具体方法，则可能更容易记住！

  1. 克隆尽可能多的数据电子表格副本（保留“原始”[例如 Sheet1] 作为备份）。
  2. 将 B 列和 C 列插入每个副本（不是 Sheet1）。
  3. 在 Sheet2 中，将 E1 和 E2 复制到 C3 和 D3。
  4. 在 Sheet3 中，将 F1 和 F2 复制到 C3 和 D3。
  5. 在 Sheet4 中，将 G1 和 G2 复制到 C3 和 D3。
  6. 根据需要重复过程 3. 到 5.。
  7. 在 Sheet2 中删除列 F 和 G。
  8. 在 Sheet3 中删除列 E 和 G。
  9. 在 Sheet4 中删除列 E 和 F。
  10. 根据需要重复过程 7. 到 9.。
  11. 在 C 列和 D 列中，在 Sheets2 到 4 中的每个范围内的数字和值中附加一个字母，比如“z”。
  12. 在工作表 2 中选择 C3 和 D3，然后双击底部 RH 角。
  13. 对所有其他工作表（Sheet1 除外）重复 12.。
  14. 从 Sheet2 中删除列 F 和 G。
  15. 从 Sheet3 中删除列 E 和 G。
  16. 从 Sheet4 中删除列 E 和 F。
  17. 根据需要重复过程 14. 到 16.。
  18. 过滤 Sheet3 中的 ColumnC 以获得 r2z 并复制可见到 Sheet2 的底部。
  19. 过滤 Sheet 4 中的 ColumnC 以获得 r3z，并将其复制到 Sheet2 的底部。
  20. 根据需要重复过程 18. 和 19.。
  21. 在 Sheet2 中，将“z”替换为空。
于 2012-07-23T15:05:41.960 回答
0

你不能只复制和粘贴特殊并选择转置吗？

实际上再次查看 OP 这不是直接转置，因为第二个屏幕打印中的前两列不是直接转置。

最终编辑

好的 - 似乎工作......

 Option Base 1

Sub moveData()

    Dim NumIterations As Integer
    NumIterations = ThisWorkbook.Sheets("target").Cells(Rows.Count, 3).End(xlUp).Row - 2

    'get the raw data and add to an array
    Dim n As Long
    Dim m As Long
    Dim myArray() As Long
    ReDim myArray(1 To NumIterations, 1 To 3)
    For n = 1 To NumIterations
        For m = 1 To 3
            myArray(n, m) = ThisWorkbook.Sheets("target").Cells(n + 2, m + 2)
        Next m
    Next n

    Dim q As Long
    Dim r As Long
    Dim myStaticArray()
    ReDim myStaticArray(1 To NumIterations, 1 To 2)
    For q = 1 To NumIterations
        For r = 1 To 2
            myStaticArray(q, r) = ThisWorkbook.Sheets("target").Cells(q + 2, r)
        Next r
    Next q


     'spit the data back out
    Dim i As Long
    Dim j As Long
    Dim myRow As Long
    myRow = 0

    For i = 1 To NumIterations
        For j = 1 To 3

            myRow = myRow + 1

            ThisWorkbook.Sheets("answer").Cells(myRow, 1) = myStaticArray(i, 1)
            ThisWorkbook.Sheets("answer").Cells(myRow, 2) = myStaticArray(i, 2)

            If j = 1 Then
                ThisWorkbook.Sheets("answer").Cells(myRow, 3) = "r1"
                ThisWorkbook.Sheets("answer").Cells(myRow, 4) = "11-000 - 13-000"
            ElseIf j = 2 Then
                ThisWorkbook.Sheets("answer").Cells(myRow, 3) = "r2"
                ThisWorkbook.Sheets("answer").Cells(myRow, 4) = "15-000 - 30-000"
            ElseIf j = 3 Then
                ThisWorkbook.Sheets("answer").Cells(myRow, 3) = "r3"
                ThisWorkbook.Sheets("answer").Cells(myRow, 4) = "31-000"
            End If

            ThisWorkbook.Sheets("answer").Cells(myRow, 5) = myArray(i, j)

        Next j
    Next i

End Sub
于 2012-07-19T20:21:06.407 回答
0

您可以使用 PasteSpecial 来完成，如下所示

Sheet(1).UsedRange.Select
Selection.Copy
ActiveWorkbook.Sheets.Add   'Make some room for pasting the cells in the new format 
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False
于 2012-07-19T20:25:52.160 回答