二维表转一维表

f8b1987

自己写的小玩意，不高明，但也有点用。

所谓二维表，个人理解是同一属性的项目，横向排列为标题。

例如：张三、李四，属性均为人名，如果成为横向列标题，则成为二维表；
如果张三、李四的名称均在一列下，该列标题为“姓名”，则该表结构为一维表。

相信大多数人也知道，二维表看起来是直观些，但数据处理起来却比一维表麻烦很多，转换为一维表则能简单、轻松处理一些数据汇总之类的问题。


格式是XLSM的，低版本office的，请自行处理。

模版：二维表转一维表.rar (42.36 KB, 下载次数: 1293)

2012-8-4 15:11 上传

点击文件名下载附件

20120526

谢谢分享！
就是版本太高了，2003版打不开。

f8b1987

对于转换格式，请下载office2007兼容包安装即可

wj2368

f8b1987 发表于 2012-8-4 19:46
对于转换格式，请下载office2007兼容包安装即可

完善一下添加列标名称

1. Sub zh()
   
2. Dim i%, arr
   
3. arr = Application.InputBox("选择区域", Type:=8)
   
4. t1 = UBound(arr)
   
5. t2 = UBound(arr, 2)
   
6. ReDim brr(1 To t1 * t2, 1 To 3)
   
7. a = Application.InputBox("请输入第二列以后的列标名称", "用逗号隔开")
   
8. b = Split(a, "，")
   
9. brr(1, 1) = arr(1, 1): brr(1, 2) = b(0): brr(1, 3) = b(1)
   
10. n = 1
    
11. For i = 2 To t1
    
12.     m = 1
    
13.     For k = i To i + t2 - 2
    
14.         n = n + 1
    
15.         m = m + 1
    
16.         brr(n, 1) = arr(i, 1)
    
17.         brr(n, 2) = arr(1, m)
    
18.         brr(n, 3) = arr(i, m)
    
19.     Next k
    
20. Next i
    
21. tishi = Application.InputBox("选择存放起始单元格", Type:=8).Address(0, 0)
    
22. Range(tishi).Resize(UBound(brr), 3) = brr
    
23. End Sub
    

复制代码

f8b1987

wj2368 发表于 2012-8-4 20:16
完善一下添加列标名称

呵呵，多谢指点完善

wqfzqgk

呵呵，再加些判断就会成为易用宝中的那个二维转一维

minren118

wj2368 发表于 2012-8-4 20:16
完善一下添加列标名称

brr(1, 1) = arr(1, 1): brr(1, 2) = b(0): brr(1, 3) = b(1)  这句代码怎么理解？特别是冒号和两个等号的作用不太明白。

panan123_0

冒号 等于 换行。
brr(1, 1) = arr(1, 1)
brr(1, 2) = b(0)
brr(1, 3) = b(1)
其实就是这样。

仰望兴叹

{:soso_e179:}

lpzxhjp

老师，你好！能否选择性的转换部分列，就像易用宝一样