Excel - 数据结构

Question

我有一个数据集，其中包含许多不同国家/地区在 12 个月内的社交媒体使用情况。

我希望重组数据，以便日期字段位于顶行，每个国家/地区的不同社交媒体类型在 B 列中垂直运行。

由于数据结构的原因，使用标准数据透视表不起作用。

标准数据透视表技术

Answer 1

用于取消旋转表格的通用宏

您可以使用下一个宏来取消透视任何表格：

Sub Unpivot()
  Dim cws As Worksheet, vs As Long, cr As Long, cc As Long, i As Long, k As Long
  Dim dr As Long, dc As Long, da As Long, ca As Variant, cb As Variant
  Dim left As Long, right As Long, up As Long, down As Long
  cr = ActiveCell.Row: cc = ActiveCell.Column
  left = Cells(cr - 1, cc).End(xlToLeft).Column: up = Cells(cr, cc - 1).End(xlUp).Row
  right = cc: While Not IsEmpty(Cells(up, right + 1)): right = right + 1: Wend
  down = cr: While Not IsEmpty(Cells(down + 1, left)): down = down + 1: Wend
  Set cws = ActiveSheet: ThisWorkbook.Sheets.Add: i = 1
  cws.Range(cws.Cells(cr - 1, left), cws.Cells(cr - 1, cc - 1)).Copy
  [A1].PasteSpecial xlPasteValues: dr = cr - up: dc = cc - left + 1
  If dr > 1 Then
    cws.Range(cws.Cells(up, cc - 1), cws.Cells(cr - 2, cc - 1)).Copy
    Cells(1, dc).PasteSpecial Paste:=xlPasteValues, Transpose:=True
  End If
  da = dc + dr:   Cells(1, da - 1) = "TBD":   Cells(1, da) = "Value"
  k = 2: vs = right - cc + 1: dr = dr + 1
  cb = WorksheetFunction.Transpose(cws.Cells(up, cc).Resize(cr - up, right - cc + 1))
  For i = cr To down
    ca = cws.Range(cws.Cells(i, left), cws.Cells(i, cc - 1))
    Cells(k, 1).Resize(vs, dc - 1) = ca: Cells(k, dc).Resize(vs, dr) = cb
    cws.Cells(i, cc).Resize(1, vs).Copy
    Cells(k, da).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    k = k + vs
  Next
End Sub

在表格中（它可以位于工作表上的任何位置，并且应受空单元格限制），选择枢轴单元格：

然后运行宏。结果表将在新工作表上创建：

预计单元格从枢轴单元格上方的一个单元格向左，从其左侧的一个单元格向上，最左边的列和最上面的行不为空。

源表可以包含任意数量的公共列和标题行：

或者，如果表格内有空单元格

可以使用下一个宏：

Sub Unpivot2()
  Dim cws As Worksheet, vs As Long, cr As Long, cc As Long, i As Long, k As Long
  Dim dr As Long, dc As Long, da As Long, ca As Variant, cb As Variant
  Dim left As Long, right As Long, up As Long, down As Long
  cr = ActiveCell.Row: cc = ActiveCell.Column
  left = Selection.Column: up = Selection.Row
  right = Selection.Column + Selection.Columns.Count - 1
  down = Selection.Row + Selection.Rows.Count - 1
  Set cws = ActiveSheet: ThisWorkbook.Sheets.Add: i = 1
  cws.Range(cws.Cells(cr - 1, left), cws.Cells(cr - 1, cc - 1)).Copy
  [A1].PasteSpecial xlPasteValues: dr = cr - up: dc = cc - left + 1
  If dr > 1 Then
    cws.Range(cws.Cells(up, cc - 1), cws.Cells(cr - 2, cc - 1)).Copy
    Cells(1, dc).PasteSpecial Paste:=xlPasteValues, Transpose:=True
  End If
  da = dc + dr:   Cells(1, da - 1) = "TBD":   Cells(1, da) = "Value"
  k = 2: vs = right - cc + 1: dr = dr + 1
  cb = WorksheetFunction.Transpose(cws.Cells(up, cc).Resize(cr - up, right - cc + 1))
  For i = cr To down
    ca = cws.Range(cws.Cells(i, left), cws.Cells(i, cc - 1))
    Cells(k, 1).Resize(vs, dc - 1) = ca: Cells(k, dc).Resize(vs, dr) = cb
    cws.Cells(i, cc).Resize(1, vs).Copy
    Cells(k, da).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    k = k + vs
  Next
End Sub

有必要选择整个表格，然后使用“Enter”和“Tab”键激活枢轴单元格