【原创】Excel 宏 - 交叉表转二维表（支持多行多列表头）

sword_liu

大家都知道，元数据最好保存成记录格式，便于更进一步的数据整理及分析（包括筛选，透视等等），但很多初学Excel的人，习惯根据工作需要直接将数据整理成了交叉表格式的报表，那么这份数据如果需要做更进一步的分析，就需要完全重新做一份报表，非常不利于数据的保存和分析。

虽然再三强调，仍然会有很多的人直接做成了交叉格式的报表，那怎么将交叉报表的数据逆向转成数据记录呢？

【福利来了】最近又碰到同事希望将交叉表的数据逆向为数据记录，所以我做了一个通用的小工具（当然是加载宏），实现了多层表头的交叉表的数据逆向整理功能。

不多扯了，直接上效果图：

这是原来的交叉表，接下来是运行工具（我是新建了一个Form，如果不想那么麻烦，可以用Application.inputbox来实现数据范围的选择和输入）：

运行后的效果：

我这里是是用了两行和两列的表头，也测试过三行三列的，大家如果有需要更多的话，可以测试下，应该不会有问题。

【干货】说了这么多，该上干货了，直接上传加载宏：
CrossTable2Record.zip (21.68 KB, 下载次数: 106)

2018-6-12 16:25 上传

点击文件名下载附件

【代码】也直接分享我的代码，欢迎大家拍砖：

1. Sub CrossTable2Record()
   
2.     On Error Resume Next
   
3.     fmCrosstable2Record.Show
   
4.     If fmCrosstable2Record.start = False Then Exit Sub
   
5.    
   
6.     Dim source As Range
   
7.     Set source = Range(fmCrosstable2Record.reSource)
   
8.     If source Is Nothing Then Exit Sub
   
9.    
   
10.     Dim rowHeader, colHeader As Integer
    
11.     rowHeader = fmCrosstable2Record.tbRowHeader.value
    
12.     colHeader = fmCrosstable2Record.tbColHeader.value
    
13.    
    
14.     Dim destination As Range
    
15.     Set destination = Range(fmCrosstable2Record.reDestination)
    
16.     If destination Is Nothing Then Exit Sub
    
17.    
    
18.     Dim recordCount As Integer
    
19.     recordCount = (source.Rows.Count - rowHeader) * (source.Columns.Count - colHeader)
    
20.    
    
21.     Application.ScreenUpdating = False
    
22.     Dim i, j, k As Integer
    
23.     Dim value
    
24.     For i = 1 + rowHeader To source.Rows.Count
    
25.         For j = 1 + colHeader To source.Columns.Count
    
26.             If Trim(source.Cells(i, j)) = "" And fmCrosstable2Record.cbIgnoreBlank.value = True Then GoTo Ignore
    
27.             If Trim(source.Cells(i, j)) = "0" And fmCrosstable2Record.cbIgnore0.value = True Then GoTo Ignore
    
28.             
    
29.             For k = 1 To colHeader
    
30.                 If source.Cells(i, k).MergeCells Then
    
31.                     value = source.Cells(i, k).MergeArea.Cells(1, 1)
    
32.                 Else
    
33.                     value = source.Cells(i, k)
    
34.                 End If
    
35.                 destination.Cells((i - rowHeader - 1) * (source.Columns.Count - colHeader) + j - colHeader, k) = value
    
36.             Next
    
37.             For k = 1 To rowHeader
    
38.                 If source.Cells(k, j).MergeCells Then
    
39.                     value = source.Cells(k, j).MergeArea.Cells(1, 1)
    
40.                 Else
    
41.                     value = source.Cells(k, j)
    
42.                 End If
    
43.                 destination.Cells((i - rowHeader - 1) * (source.Columns.Count - colHeader) + j - colHeader, k + colHeader) = value
    
44.             Next
    
45.             destination.Cells((i - rowHeader - 1) * (source.Columns.Count - colHeader) + j - colHeader, rowHeader + colHeader + 1) = source.Cells(i, j)
    
46. Ignore:
    
47.             Application.StatusBar = Format((i - rowHeader) * (j - rowHeader) / recordCount * 100, "0.00") & "% & - " & (i - rowHeader) * (j - rowHeader) & " of " & recordCount
    
48.             DoEvents
    
49.         Next
    
50.     Next
    
51.     Range(destination.Cells(1, 1), destination.Cells((source.Rows.Count - rowHeader) * (source.Columns.Count - colHeader), rowHeader + colHeader + 1)).Sort destination.Columns(rowHeader + colHeader), xlAscending, Header:=xlNo
    
52.     Application.StatusBar = ""
    
53.    
    
54. End Sub

复制代码