VBA中VLOOKUP可以找值，如何实现带颜色格式查找匹配

happy0620

各位好，VBA中VLOOKUP可以找值，如何实现带颜色格式查找匹配？另外能查找得到单元格的地址吗？

请各位大侠帮忙解答，谢谢！

小花鹿

只能用复制粘贴的方法..............................................................................................

microyip

可以用字典记录颜色状况为Key，赋予相应的单元格为Item

happy0620

microyip 发表于 2017-4-21 07:40
可以用字典记录颜色状况为Key，赋予相应的单元格为Item

字典不会，可以举例一下吗？

happy0620

小花鹿 发表于 2017-4-21 01:15
只能用复制粘贴的方法................................................................................ ...

谢谢，应该有方法的，等待高手出现。

happy0620

没有高手解答，是太难了，还是实现不了呢，自己研究了下，可以转换为，用查找填充单元格或字体颜色的方法，分享一下方法。请查找匹配方法，会的朋友不吝赐教，谢谢！

1. Public Sub 查找填充颜色()
   
2. 
   
3.     Dim arr_color(1 To 7)
   
4.    
   
5.     arr_color(1) = RGB(255, 0, 0) '红
   
6.     arr_color(2) = RGB(255, 255, 0) '黄
   
7.     arr_color(3) = RGB(0, 176, 80) '绿
   
8.     arr_color(4) = RGB(0, 176, 240) '白蓝
   
9.     arr_color(5) = RGB(0, 112, 192) '蓝
   
10.     arr_color(6) = RGB(194, 214, 154) '白绿
    
11.     arr_color(7) = RGB(255, 255, 255) '白
    
12.    
    
13.     For j = 7 To 7
    
14.         For i = 2 To 18
    
15.             '填充单元格颜色
    
16.             If Cells(i, j) = "888888" Then Cells(i, j).Interior.Color = arr_color(1)
    
17.             If Cells(i, j) = "88888" Then Cells(i, j).Interior.Color = arr_color(2)
    
18.             If Cells(i, j) = "8888" Then Cells(i, j).Interior.Color = arr_color(3)
    
19.             If Cells(i, j) = "888" Then Cells(i, j).Interior.Color = arr_color(4)
    
20.             If Cells(i, j) = "88" Then Cells(i, j).Interior.Color = arr_color(5)
    
21.             If Cells(i, j) = "8" Then Cells(i, j).Interior.Color = arr_color(6)
    
22.             '填充字体颜色
    
23. '            If Cells(i, j) = "888888" Then Cells(i, j).Font.Color = arr_color(1)
    
24. '            If Cells(i, j) = "88888" Then Cells(i, j).Font.Color = arr_color(2)
    
25. '            If Cells(i, j) = "8888" Then Cells(i, j).Font.Color = arr_color(3)
    
26. '            If Cells(i, j) = "888" Then Cells(i, j).Font.Color = arr_color(4)
    
27. '            If Cells(i, j) = "88" Then Cells(i, j).Font.Color = arr_color(5)
    
28. '            If Cells(i, j) = "8" Then Cells(i, j).Font.Color = arr_color(6)
    
29.         Next
    
30.     Next
    
31. End Sub

复制代码

    有好的方法，请大家不吝赐教，谢谢！

philijian

1. Sub test()
   
2. Dim arr, i, j
   
3. Dim d As Object, d1 As Object
   
4. Set d = CreateObject("scripting.dictionary")
   
5. Set d1 = CreateObject("scripting.dictionary")
   
6. With Sheets("Sheet1")
   
7.     arr = .Range("a1").CurrentRegion
   
8.     For i = 2 To UBound(arr)
   
9.         d(arr(i, 1)) = arr(i, 2)
   
10.         d1(arr(i, 1)) = .Cells(i, 2).Interior.Color
    
11.     Next i
    
12.     For j = 2 To .Range("i2").End(xlDown).Row
    
13.         .Cells(j, "j") = d(.Cells(j, "i").Value)
    
14.         .Cells(j, "j").Interior.Color = d1(.Cells(j, "i").Value)
    
15.     Next j
    
16. End With
    
17. End Sub
    

复制代码

shi353

Sub test1()
Dim arr, i
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
    arr = .Range("a1").CurrentRegion
    For i = 2 To UBound(arr)
        d(.Cells(i, 2).Interior.ColorIndex) = arr(i, 1)
    Next i
End With
Set A = Range([Sheet1!j2], [Sheet1!j18])
For i = 1 To A.Cells.Count
    With A.Cells(i)
        .Offset(, 1) = d(.Interior.ColorIndex)
    End With
Next
End Sub
'將dictionary 字典的key當成查找關健值查出對應item→等同vlookup一樣!

philijian

貌似楼上的和楼主的需求不是一回事...楼主是要根据I列输出J列，不是根据J列输出I列

happy0620

philijian 发表于 2017-4-22 22:46

好的，谢谢！要开始学习一下这种字典。