[已解决]求助论坛前辈，vba批量填充字体颜色

yslvictor

我是vba入门，实际运用中需要把下列表按要求把D:M列填充字体颜色，请老师帮忙写段代码。

图1为填充i前
图2填充后

最佳答案

月排行榜 / 总排行榜

gaoshuichang1

2012-7-23 10:15

1. Sub aa()
   
2. Dim x As Integer, y As Integer, i As Integer
   
3. For i = 2 To Range("b65536").End(3).Row
   
4. For x = 1 To 100
   
5. For y = 4 To 13
   
6.     If Cells(x, y) = Cells(i, 2) Then
   
7.         Cells(x, y).Font.ColorIndex = Cells(i, 1)
   
8.     End If
   
9. Next y
   
10. Next x
    
11. Next i
    
12. End Sub
    

复制代码

跳转到最佳答案楼层

womohe

1. Sub a()
   
2. Dim rng As Range
   
3. Dim x%
   
4. For Each rng In Range("d:m")
   
5. For x = 2 To Range("b65536").End(3).Row
   
6. If rng = Cells(x, 2) Then
   
7. rng.Font.ColorIndex = Cells(x, 1)
   
8. End If
   
9. Next x
   
10. Next rng
    
11. End Sub

复制代码

桀骜孤星

1. 
   
2. Sub test()
   
3. Dim rng As Range
   
4. 
   
5. Set d = CreateObject("scripting.dictionary")
   
6. For i = 2 To [a65536].End(3).Row
   
7. d(Cells(i, 2).Value) = Cells(i, 1).Value
   
8. Next
   
9. 
   
10. For Each rng In Sheets("要填充字体").Range("d1:m1000")
    
11. If rng <> "" Then
    
12. 
    
13. rng.Font.ColorIndex = d(rng.Value)
    
14. End If
    
15. Next
    
16. 
    
17. End Sub
    

复制代码

填充颜色.rar (9.82 KB, 下载次数: 10)

2012-7-23 09:45 上传

点击文件名下载附件

gaoshuichang1

1. Sub aa()
   
2. Dim x As Integer, y As Integer, i As Integer
   
3. For i = 2 To Range("b65536").End(3).Row
   
4. For x = 1 To 100
   
5. For y = 4 To 13
   
6.     If Cells(x, y) = Cells(i, 2) Then
   
7.         Cells(x, y).Font.ColorIndex = Cells(i, 1)
   
8.     End If
   
9. Next y
   
10. Next x
    
11. Next i
    
12. End Sub
    

复制代码

yslvictor

谢谢论坛前辈，你们辛苦了。

gxglmcy

最佳答案果然写得运算又快又好