[已解决]求地址

张雄友

求地址.

最佳答案

月排行榜 / 总排行榜

dsmch

2015-3-4 09:03

如果有相同，用逗号隔开

1. Function LX(rng)
   
2. Set d = CreateObject("scripting.dictionary")
   
3. Set rg = rng(1).Resize(rng.Count + 1)
   
4. Set c = rg(1)
   
5. For i = 2 To rg.Count
   
6.     If rg(i) - 1 = rg(i - 1) Then
   
7.        Set c = Union(c, rg(i))
   
8.     Else
   
9.        d(c.Address(0, 0)) = c.Count
   
10.        Set c = rg(i)
    
11.     End If
    
12. Next
    
13. a = d.keys: b = d.items: p = ""
    
14. n = Application.Max(d.items)
    
15. For i = 0 To d.Count - 1
    
16.     If b(i) = n Then p = p & "," & a(i)
    
17. Next
    
18. LX = n & "(" & Mid(p, 2) & ")"
    
19. End Function

复制代码

跳转到最佳答案楼层

ppp710715

4——B4：B7是B4：B7单元格的值都大于4，好理解。
但15——A1:A15啥意思？

dsmch

如果有相同，用逗号隔开

1. Function LX(rng)
   
2. Set d = CreateObject("scripting.dictionary")
   
3. Set rg = rng(1).Resize(rng.Count + 1)
   
4. Set c = rg(1)
   
5. For i = 2 To rg.Count
   
6.     If rg(i) - 1 = rg(i - 1) Then
   
7.        Set c = Union(c, rg(i))
   
8.     Else
   
9.        d(c.Address(0, 0)) = c.Count
   
10.        Set c = rg(i)
    
11.     End If
    
12. Next
    
13. a = d.keys: b = d.items: p = ""
    
14. n = Application.Max(d.items)
    
15. For i = 0 To d.Count - 1
    
16.     If b(i) = n Then p = p & "," & a(i)
    
17. Next
    
18. LX = n & "(" & Mid(p, 2) & ")"
    
19. End Function

复制代码

好吧，又是VBA，会用E立方平台，何必如此纠结。

张雄友

dsmch 发表于 2015-3-4 09:03
如果有相同，用逗号隔开

为什么只对数字有效？混合呢？

张雄友

dsmch 发表于 2015-3-4 09:03
如果有相同，用逗号隔开

没有这样的，我的意思是要么全部是数字(如：11，12，13，14，......)，要么是：AK-01,AK-02,AK-03......这样的，是生产制单来的。没有你说的：a23bd12这种令人捉摸的情况 。

香川群子

dsmch 发表于 2015-3-4 09:03
如果有相同，用逗号隔开

【楼主的问题一向是不断升级的，】

一阵见血 啊！

张雄友在VBA里混很久了……但水平一直不长进，特别喜欢伸手要结果……

唯一的优点(也是烦人之处)，就是最喜欢钻牛角尖，提出更复杂的要求。

上清宫主

啷个把老实话说出来了呢？

张雄友

上清宫主 发表于 2015-3-6 09:29
啷个把老实话说出来了呢？

嗯，没有什么可丢人的，要不然我的工资也不会才 3295元人民币一个月。习惯取笑别人也不是一件好事。