Excel不定行转置

zhongtang

假期中，接到业务一个Excel的求助电话，比较复杂，结合百度，经过一晚上的努力，幸不辱命。

还是看数据说话，有一个Excel数据表A，原型如下：
编码   名称      供应商

111   阿莫西林   公司AAA

111   阿莫西林   公司BBB

111   阿莫西林   公司CCC

222   达克宁     公司CCC

222   达克宁     公司BBB

333   康泰克     公司BBB

444   阿莫西林1   公司AAA

444   阿莫西林1   公司BBB

444   阿莫西林1   公司CCC  

 

希望得到数据表B，处理结果如下：

编码   名称      供应商1      供应商2      供应商3     供应商4  ...

111   阿莫西林   公司AAA      公司BBB      公司CCC

222   达克宁     公司CCC      公司BBB
333   康泰克     公司BBB

444   阿莫西林1   公司AAA     公司BBB      公司CCC

 

很显然，这是一个转置问题，但是有两个问题：

1.原始表A中数据巨大，近十万行记录，而且由原始表-> 结果表的过程希望可以重复；

2.原始表中每一个编码的记录行数不确定。

总结起来就是 “不定行转置，或者分组转置”

 

解决方案：

首先想到的把原始表导入数据库，用sql实现；好处是快速，缺点是门槛太高，需要信息部门介入，所以用VBA是一个比较合理的方案，具体算法如下：

 

1. Sub MySort()
   
2. 
   
3.     '取消筛选
   
4.     Workbooks(1).Activate
   
5.     If ActiveSheet.AutoFilterMode Then '如果 表2 当前为自动过滤状态
   
6.         Selection.AutoFilter '取消过滤
   
7.     End If
   
8.     
   
9.         
   
10.     '先排序
    
11.     Columns("A:O").Select
    
12.     Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("C1") _
    
13.         , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
    
14.         False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _
    
15.         xlSortNormal, DataOption2:=xlSortNormal
    
16.     
    
17.         
    
18.     Dim RowCount, ColCount, FlagCol
    
19.     '取最大行数,excel2007 max rows =1048576,excel2003 max rows =65536
    
20.     'RowCount = Selection.Rows.Count
    
21.     RowCount = Range("A1048576").End(xlUp).Row
    
22.     '取最大列数
    
23.     ColCount = Selection.Columns.Count
    
24.     '新增一列用来标记是否第一行
    
25.     FlagCol = ColCount + 1
    
26.     'MsgBox "总行数" & RowCount & ",总列数" & ColCount & " " & ColCount + 1 & Cells(1, ColCount)
    
27.     '第一行是表头，第二行才是数据
    
28.     For i = 2 To RowCount
    
29.         j = 1
    
30.         Cells(i, ColCount + 1) = "1"
    
31.         Do While True
    
32.             If Cells(i, 1) = Cells(i + j, 1) Then
    
33.                 Cells(i + j, FlagCol) = "0"
    
34.                 ' 第3列是“转置”列
    
35.                 Cells(i, FlagCol + j) = Cells(i + j, 3)
    
36.             Else
    
37.                 i = i + j - 1
    
38.                 Exit Do
    
39.             End If
    
40.             j = j + 1
    
41.         Loop
    
42.     Next
    
43.     
    
44.     Columns("A:S").Select
    
45.     Selection.AutoFilter
    
46.     ActiveSheet.Range("$A$1:$S" & RowCount).AutoFilter Field:=FlagCol, Criteria1:="1"
    
47. 
    
48. 
    
49.  End Sub

 

 

alimama_pid="mm_12187975_1642518_5895203"; alimama_titlecolor="0000FF"; alimama_descolor ="000000"; alimama_bgcolor="FFFFFF"; alimama_bordercolor="E6E6E6"; alimama_linkcolor="008000"; alimama_bottomcolor="FFFFFF"; alimama_anglesize="0"; alimama_bgpic="0"; alimama_icon="0"; alimama_sizecode="38"; alimama_width=290; alimama_height=200; alimama_type=2;