[已解决]代码怎么进行优化呢

excel白兔

Private Sub CommandButton1_Click()
    Dim a, c As Range
    For Each a In Range("A1:if500")
        If a.Interior.ColorIndex <> xlNone Then
            If c Is Nothing Then
                Set c = a
            Else
                Set c = Union(c, a)
            End If
        End If
    Next
    If Not c Is Nothing Then
        c.Select
    End If
End Sub


这个代码怎么能优化下呢 因为范围是在很大  运算起来太慢了15分钟都没弄出来
这个是 选中代色的单元格代码

最佳答案

月排行榜 / 总排行榜

mxg825

2012-8-7 15:35

’搞定 用时 20秒

1. Private Sub CommandButton1_Click()
   
2.     Dim MyAdd As String, TmpAdd As String
   
3.     Dim C As Range, Ran As Range, T As Single
   
4.     Dim Mrow%, Mcol%
   
5.     T = Timer
   
6.         For Each Ran In Range("A1:IF500")
   
7.             If Ran.Interior.ColorIndex <> xlNone Then
   
8.                 TmpAdd = MyAdd
   
9.                 MyAdd = MyAdd & Ran.Address(0, 0) & ","
   
10.                     If Len(MyAdd) > 255 Then
    
11.                         MyAdd = TmpAdd
    
12.                         Call UinonRan(C, MyAdd)
    
13.                         MyAdd = Ran.Address(0, 0) & ","
    
14.                     End If
    
15.             End If
    
16.         Next
    
17.     If Len(MyAdd) > 0 Then Call UinonRan(C, MyAdd)
    
18.     If Not C Is Nothing Then
    
19.         C.Select
    
20.     End If
    
21.    MsgBox Timer - T
    
22. End Sub
    
23. Sub UinonRan(ByRef RanA As Range, RanAdd As String)
    
24.     RanAdd = Left(RanAdd, Len(RanAdd) - 1)
    
25.     If RanA Is Nothing Then
    
26.         Set RanA = Range(RanAdd)
    
27.     Else
    
28.         Set RanA = Union(RanA, Range(RanAdd))
    
29.     End If
    
30. End Sub

复制代码

跳转到最佳答案楼层

JLxiangwei

上附件，没有附件不好弄

excel白兔

JLxiangwei 发表于 2012-8-6 16:16
上附件，没有附件不好弄

附件弄完了
就是运算的太慢了 老师帮我看看呗

mxg825

’搞定 用时 20秒

1. Private Sub CommandButton1_Click()
   
2.     Dim MyAdd As String, TmpAdd As String
   
3.     Dim C As Range, Ran As Range, T As Single
   
4.     Dim Mrow%, Mcol%
   
5.     T = Timer
   
6.         For Each Ran In Range("A1:IF500")
   
7.             If Ran.Interior.ColorIndex <> xlNone Then
   
8.                 TmpAdd = MyAdd
   
9.                 MyAdd = MyAdd & Ran.Address(0, 0) & ","
   
10.                     If Len(MyAdd) > 255 Then
    
11.                         MyAdd = TmpAdd
    
12.                         Call UinonRan(C, MyAdd)
    
13.                         MyAdd = Ran.Address(0, 0) & ","
    
14.                     End If
    
15.             End If
    
16.         Next
    
17.     If Len(MyAdd) > 0 Then Call UinonRan(C, MyAdd)
    
18.     If Not C Is Nothing Then
    
19.         C.Select
    
20.     End If
    
21.    MsgBox Timer - T
    
22. End Sub
    
23. Sub UinonRan(ByRef RanA As Range, RanAdd As String)
    
24.     RanAdd = Left(RanAdd, Len(RanAdd) - 1)
    
25.     If RanA Is Nothing Then
    
26.         Set RanA = Range(RanAdd)
    
27.     Else
    
28.         Set RanA = Union(RanA, Range(RanAdd))
    
29.     End If
    
30. End Sub

复制代码

excel白兔

mxg825 发表于 2012-8-7 15:35
’搞定 用时 20秒

谢谢老师 虽然没有20秒搞定 但是也很快了
在我的电脑上要50多秒呢  呵呵
老师能否把这个代码的意思写上 我好自己研究研究麻烦了

mxg825

excel白兔 发表于 2012-8-9 13:52
谢谢老师 虽然没有20秒搞定 但是也很快了
在我的电脑上要50多秒呢  呵呵
老师能否把这个代码的意思写上 ...

代码的 优化 主体思路是：
先把 单元格Address 属性地址 用字符串 串在一起！
当字符个数达到 255个时，再用 Union组合 单元格！
（你原来的写法是，一个，一个单元格的组合）
我的写法，是一次N多个单元格串好，再组合！（所以省下了 组合时间）

例如： 下面 （红色 和蓝色 对比）
'你的组合法
Set C = Union(Range("A1"), Range("A2"), Range("B5"), Range("C7"), Range("D9"))
'我的组合法
Set C = Union(Range("A1"), Range("A2,B5,C7,D9"))