首页 > 解决方案 > 如何将具有多个 y 轴的表格转换为简单表格?

问题描述

我有一个带有 1 个 x 轴(名称)和 1 个 y 轴(年、月、版本)的表。我想将其转换为可以在数据透视表中使用的适当表格 - 实际上,该表格将具有名称、年份、月份、版本和值。有没有办法做到这一点

样品表

标签: exceldatabase-designdatatablepivot

解决方案


您可以使用以下代码:

Sub SubRearrangeTable()
    
    'Declarations.
    Dim DblNameColumn As Double
    Dim DblYearRow As Double
    Dim DblMonthRow As Double
    Dim DblVersionRow As Double
    Dim DblValueRow As Double
    Dim RngTarget As Range
    Dim RngDestination As Range
    Dim RngData As Range
    Dim WksData As Worksheet
    Dim WksNewTable As Worksheet
    
    'Setting RngData as the first top-left cell containint data.
    Set RngData = Sheets("Sheet1").Range("B4")
    
    'Setting variables to match the column and rows of each "non-Value" data.
    DblNameColumn = 1
    DblYearRow = 2
    DblMonthRow = 3
    DblVersionRow = 1
    
    'Resizing RngData to cover the entire list of data (the list is assumed to be a rectangle solidly filled in data).
    Set RngData = RngData.Parent.Range(RngData, RngData.End(xlDown).End(xlToRight))
    
    'Setting WksData as the worksheet where the data list is located.
    Set WksData = RngData.Parent
    
    'Creating a new sheet where result will be posted.
    Set WksNewTable = Sheets.Add(After:=ActiveSheet)
    
    'Focusing WksNewTable.
    With WksNewTable
        
        'Filling the headers of the report.
        .Cells(1, 1).Value = "Name"
        .Cells(1, 2).Value = "Year"
        .Cells(1, 3).Value = "Month"
        .Cells(1, 4).Value = "Verion"
        .Cells(1, 5).Value = "Value"
        
        'Setting RngDestination.
        Set RngDestination = .Cells(2, 1)
        
    End With
    
    'Covering all the cells in RngData.
    For Each RngTarget In RngData
        
        'Reporting the values accordingly.
        RngDestination.Offset(0, 0).Value = WksData.Cells(RngTarget.Row, DblNameColumn).Value
        RngDestination.Offset(0, 1).Value = WksData.Cells(DblYearRow, RngTarget.Column).Value
        RngDestination.Offset(0, 2).Value = WksData.Cells(DblMonthRow, RngTarget.Column).Value
        RngDestination.Offset(0, 3).Value = WksData.Cells(DblVersionRow, RngTarget.Column).Value
        RngDestination.Offset(0, 4).Value = RngTarget.Value
        Set RngDestination = RngDestination.Offset(1, 0)
    Next
        
End Sub

该代码假定您列出的列表位于 Sheet1 的 A1 范围内,使单元格 B4 成为第一个具有值的单元格。如果不是这种情况,只需Set RngData = Sheets("Sheet1").Range("B4")相应地编辑该行。该代码还假设您的表格中已填满数据(没有空单元格)。如果不是这种情况,它可能不会覆盖整个表。这当然可以解决。

如果您不熟悉 VBA,要使代码正常工作:

  1. 打开您的 Excel 文件;
  2. 按 Alt+F11;
  3. 在从子菜单插入选择模块出现的新窗口(Microsoft Visual Basic)中;
  4. 复制粘贴刚才出现的空白模块中的代码;
  5. [可选] 根据您的需要编辑代码,如前所述;
  6. 按 F5;如果弹出另一个名为 Macro 的窗口,只需确保选中 SubRearrangeTable,然后单击 Run。

推荐阅读