如何二维表转成交叉表?

zjwww

如何二维表转成交叉表?

as42065300

最简单的用透视表

hyefeifei

不用透视： 转交叉表.rar (14.08 KB, 下载次数: 100)

2015-4-6 23:54 上传

点击文件名下载附件

as42065300

代码写了我也就发下，和3楼的思路不同效果一样：

1. 
   
2. Sub Ti()
   
3. Dim dic(2) As Object, arr()
   
4. For x = 0 To 2
   
5.     Set dic(x) = CreateObject("Scripting.Dictionary")
   
6. Next
   
7. brr = Sheet1.Range("a2").CurrentRegion
   
8. For x = 2 To UBound(brr)
   
9.     dic(0)(brr(x, 1)) = brr(x, 2)
   
10.     dic(1)(brr(x, 3)) = brr(x, 4)
    
11.     Ts = brr(x, 1) & "/" & brr(x, 2) & "/" & brr(x, 3) & "/" & brr(x, 4)
    
12.     dic(2)(Ts) = brr(x, 5)
    
13. Next
    
14. ReDim arr(1 To dic(0).Count + 3, 1 To dic(1).Count + 3)
    
15. Ts = dic(0).Keys: T = dic(1).Keys
    
16. For y = 0 To UBound(T)
    
17.     arr(1, y + 3) = T(y)
    
18.     arr(2, y + 3) = dic(1)(T(y))
    
19.     For x = 0 To UBound(Ts)
    
20.         If arr(x + 3, 1) = "" Then
    
21.            arr(x + 3, 1) = Ts(x)
    
22.            arr(x + 3, 2) = dic(0)(Ts(x))
    
23.            rr = arr(x + 3, 1) & "/" & arr(x + 3, 2) & "/" & arr(1, y + 3) & "/" & arr(2, y + 3)
    
24.            If dic(2).Exists(rr) Then arr(x + 3, y + 3) = dic(2)(rr)
    
25.            arr(UBound(arr), y + 3) = arr(UBound(arr), y + 3) + dic(2)(rr)
    
26.         Else
    
27.            rr = arr(x + 3, 1) & "/" & arr(x + 3, 2) & "/" & arr(1, y + 3) & "/" & arr(2, y + 3)
    
28.            If dic(2).Exists(rr) Then arr(x + 3, y + 3) = dic(2)(rr)
    
29.            arr(UBound(arr), y + 3) = arr(UBound(arr), y + 3) + dic(2)(rr)
    
30.         End If
    
31.            arr(x + 3, UBound(arr, 2)) = arr(x + 3, UBound(arr, 2)) + arr(x + 3, y + 3)
    
32.            arr(UBound(arr), UBound(arr, 2)) = arr(UBound(arr), UBound(arr, 2)) + arr(x + 3, y + 3)
    
33.     Next
    
34. Next
    
35.     arr(UBound(arr), 1) = "总计": arr(1, UBound(arr, 2)) = "总计"
    
36.     Range("g12").Resize(UBound(arr), UBound(arr, 2)) = arr
    
37. End Sub
    

复制代码

zjwww

hyefeifei 发表于 2015-4-6 23:55
不用透视：

谢谢,移用代码运行正常.

zjwww

hyefeifei 发表于 2015-4-6 23:55
不用透视：

谢谢,移用代码操作正常.

zjwww

as42065300 发表于 2015-4-7 00:39
代码写了我也就发下，和3楼的思路不同效果一样：

谢谢,有个问题:移用代码运行,弹出窗口:"编译错误:没有函数或变量",啥回事?

zjwww

as42065300 发表于 2015-4-7 00:39
代码写了我也就发下，和3楼的思路不同效果一样：

估计你用2007编译的，在2003上出现"编译错误:没有函数或变量"此种问题,可能在

• Ts = dic(0).Keys: T = dic(1).Keys是不是T没有定义?
  

as42065300

选项卡里红色框去掉勾选！
或者将代码最顶端的这句 Option Explicit 去掉就可以用了！

zjwww

谢谢!
栓查了一下,没有设置"要求变量声明"选项和Option Explicit
问题在.我本人对CurrentRegion理解有误.搞清楚了,谢谢.