[已解决]数据相互转换

su45

你能不能改个思路呀，不用这个名称，就是做了VBA，你漏了一个命名，VBA就会出错！更何况你说有几百个，那你都要命名，不麻烦吗？

su45

而且，你的命名也不规则，

ms967967

su45 发表于 2014-8-28 12:58
而且，你的命名也不规则，

重命名是考虑到我的实际应用，我也在纠结这个命名问题（因为有些命名会与单元格名重复)，您不用考虑重命名，只用单元格名就可以。

su45

相互转换.zip (19.05 KB, 下载次数: 3)

2014-8-28 18:06 上传

点击文件名下载附件

su45

1. Sub suaa()
   
2. Dim arr()
   
3. Set Rng = Range("A4").CurrentRegion
   
4. For i = 1 To Rng.Columns.Count
   
5.     n = 1
   
6.     s = Rng(n, i).Address(0, 0)
   
7.     sr = Rng(n, i).Value
   
8.     Do
   
9.         If Rng(n + 1, i) = Rng(n, i) Then
   
10.             e = Rng(n + 1, i).Address(0, 0)
    
11.             n = n + 1
    
12.         Else
    
13.             x = x + 1
    
14.             ReDim Preserve arr(1 To 2, 1 To x)
    
15.             arr(1, x) = s & "-" & e
    
16.             arr(2, x) = sr
    
17.             s = Rng(n + 1, i).Address(0, 0)
    
18.             sr = Rng(n + 1, i).Value
    
19.             n = n + 1
    
20.         End If
    
21.     Loop While n < Rng.Rows.Count + 1
    
22. Next
    
23. Sheets("汇总").Range("A2").Resize(UBound(arr, 2), UBound(arr)) = Application.Transpose(arr)
    
24. End Sub
    

复制代码