[已解决]帮个忙，编个小程序！

公益林

由A-G列数据汇总得到黄色区域数据，请用VBA代码编写，谢谢了！

最佳答案

月排行榜 / 总排行榜

蓝桥玄霜

2012-11-16 16:57

1. Sub lqxs()
   
2. Dim Arr, i&, x$, j&, aa, ks, js
   
3. Dim d, k, t, bb
   
4. Application.DisplayAlerts = False
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. Sheet1.Activate
   
7. Arr = [a1].CurrentRegion
   
8. For i = 2 To UBound(Arr)
   
9.     x = Arr(i, 5) & "," & Arr(i, 6)
   
10.     d(x) = d(x) & i & ","
    
11. Next
    
12. k = d.keys
    
13. t = d.items
    
14. [k4].Resize(d.Count) = Application.Transpose(k)
    
15. [k4].Resize(d.Count).TextToColumns Comma:=True
    
16. For i = 0 To UBound(k)
    
17.     t(i) = Left(t(i), Len(t(i)) - 1)
    
18.     If InStr(t(i), ",") Then
    
19.         aa = Split(t(i), ",")
    
20.         ReDim bb(UBound(aa))
    
21.         For j = 0 To UBound(aa)
    
22.             bb(j) = Arr(aa(j), 8)
    
23.         Next
    
24.         ks = Application.Min(bb)
    
25.         js = Application.Max(bb)
    
26.         Cells(i + 4, 13) = ks & "-" & js
    
27.     Else
    
28.         Cells(i + 4, 13) = t(i)
    
29.     End If
    
30.     Cells(i + 4, 10) = i + 1
    
31. Next
    
32. Application.DisplayAlerts = True
    
33. End Sub
    

复制代码

跳转到最佳答案楼层

蓝桥玄霜

1. Sub lqxs()
   
2. Dim Arr, i&, x$, j&, aa, ks, js
   
3. Dim d, k, t, bb
   
4. Application.DisplayAlerts = False
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. Sheet1.Activate
   
7. Arr = [a1].CurrentRegion
   
8. For i = 2 To UBound(Arr)
   
9.     x = Arr(i, 5) & "," & Arr(i, 6)
   
10.     d(x) = d(x) & i & ","
    
11. Next
    
12. k = d.keys
    
13. t = d.items
    
14. [k4].Resize(d.Count) = Application.Transpose(k)
    
15. [k4].Resize(d.Count).TextToColumns Comma:=True
    
16. For i = 0 To UBound(k)
    
17.     t(i) = Left(t(i), Len(t(i)) - 1)
    
18.     If InStr(t(i), ",") Then
    
19.         aa = Split(t(i), ",")
    
20.         ReDim bb(UBound(aa))
    
21.         For j = 0 To UBound(aa)
    
22.             bb(j) = Arr(aa(j), 8)
    
23.         Next
    
24.         ks = Application.Min(bb)
    
25.         js = Application.Max(bb)
    
26.         Cells(i + 4, 13) = ks & "-" & js
    
27.     Else
    
28.         Cells(i + 4, 13) = t(i)
    
29.     End If
    
30.     Cells(i + 4, 10) = i + 1
    
31. Next
    
32. Application.DisplayAlerts = True
    
33. End Sub
    

复制代码

公益林

谢谢，太有用了！！！

hamsik11

蓝桥玄霜 发表于 2012-11-16 16:57

请问下老师，您的代码里面经常用到

• Sheet1.Activate
• Arr = [a1].CurrentRegion
  

先激活一个sheet然后，再进行操作，这样和

with sheet1
  ARR=.[a1].CurrentRegion


这两个有区别吗？ 还是个人习惯的问题？谢谢