[已解决]求优化代码（根据对比颜色，返回指定的数值）

lingdu

Private Sub CommandButton2_Click()  
Dim arr, i As Integer, j As Integer, k As Range, n As Range, d
Application.ScreenUpdating = False
i = Range("a65536").End(xlUp).Row
j = Range("x65536").End(xlUp).Row
        For Each k In Range("w2:w" & j)   '对比标准的颜色是在W列
            For Each n In Range("a2:j" & i) '需要处理的颜色是在A列到J列
                If n.Interior.ColorIndex = k.Interior.ColorIndex Then     '如果A:J列的单元格的颜色和W列的颜色是一样的，那么执行以下操作
                    n.Value = k.Offset(0, 1).Value   'A:J列对应的单元格等于W列偏移一列（即X列）的数值
                End If  '结束判断
            Next
        Next
Application.ScreenUpdating = True
End Sub



麻烦高手们，帮忙优化下，我加了with效果不是很明显，小生最近正努力学数组中，但研究半天还是没有能用数组来解决。这段代码虽然能实现效果，结果也是对是，可随着数据量变大，说不定会有卡死的情况。。。


先谢过高手们了

最佳答案

月排行榜 / 总排行榜

grf1973

2014-12-8 15:04

1. Private Sub CommandButton2_Click()
   
2. Dim n As Range
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To 11
   
5.         xcolor = Cells(i, "W").Interior.ColorIndex
   
6.         d(xcolor) = Cells(i, "x")
   
7.     Next
   
8.     For Each n In Range("a2:j19")
   
9.         n.Value = d(n.Interior.ColorIndex)
   
10.     Next
    
11. End Sub

复制代码

跳转到最佳答案楼层

as0810114

上传附件。

lingdu

谢谢高手了，里面已经有代码了，，

lingdu

as0810114 发表于 2014-12-8 13:03
上传附件。

谢谢您了。。感激不尽呐

grf1973

1. Private Sub CommandButton2_Click()
   
2. Dim n As Range
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To 11
   
5.         xcolor = Cells(i, "W").Interior.ColorIndex
   
6.         d(xcolor) = Cells(i, "x")
   
7.     Next
   
8.     For Each n In Range("a2:j19")
   
9.         n.Value = d(n.Interior.ColorIndex)
   
10.     Next
    
11. End Sub

复制代码

grf1973

请看附件。

芐雨

1. Private Sub CommandButton2_Click()
   
2.     Dim arr, dic
   
3.     Dim xcolor&, x&, j&, i&, lrow&, xRow&
   
4.     Application.ScreenUpdating = False
   
5.     xRow = Range("x65536").End(xlUp).Row
   
6.     Set dic = CreateObject("scripting.dictionary")
   
7.     For i = 2 To xRow
   
8.         xcolor = Cells(i, 23).Interior.ColorIndex
   
9.         x = Cells(i, 24)
   
10.         dic(xcolor) = x
    
11.     Next
    
12.     lrow = Range("a65536").End(xlUp).Row
    
13.     ReDim arr(1 To lrow, 1 To 10)
    
14.     For i = 1 To lrow
    
15.         For j = 1 To 10
    
16.             arr(i, j) = dic(Cells(i, j).Interior.ColorIndex)
    
17.         Next
    
18.     Next
    
19.    [A1].Resize(lrow, 10) = arr
    
20.     Application.ScreenUpdating = True
    
21. End Sub

复制代码