|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub Y颜色标注()
- Set d = CreateObject("scripting.dictionary")
- Application.ScreenUpdating = False
- Union(Columns(2), Columns(9)).Interior.ColorIndex = 0
- Union(Columns(2), Columns(9)).Font.ColorIndex = 0
- For j = 2 To Cells(Rows.Count, "i").End(3).Row
- If Len(Cells(j, "i")) > 0 Then Set d(Cells(j, "i").Value) = Cells(j, "i")
- Next j
- For j = 2 To Cells(Rows.Count, "b").End(3).Row
- If d.exists(Cells(j, "b").Value) Then
- Cells(j, 3) = Columns(9).Find(Cells(j, "b"), lookat:=xlWhole).Offset(0, 1)
-
- Union(Cells(j, 2), d(Cells(j, "b").Value)).Interior.ColorIndex = 22
- Else
- If InStr(Cells(j, 2), "[") > 0 Then
- arr = Split(Split(Cells(j, 2), "]")(0), "[")
- If d.exists(arr(0)) And d.exists(arr(1)) Then
- Cells(j, 3) = Columns(9).Find(arr(0), lookat:=xlWhole).Offset(0, 1)
- Union(Cells(j, 2), d(arr(0)), d(arr(1))).Interior.ColorIndex = 22
- Else
- If d.exists(arr(0)) Then
- d(arr(0)).Interior.ColorIndex = 3
- Cells(j, 3) = Columns(9).Find(arr(0), lookat:=xlWhole).Offset(0, 1)
- Cells(j, 2).Characters(Start:=1, Length:=Len(arr(0))).Interior.ColorIndex = 3
- End If
-
- If d.exists(arr(1)) Then
- d(arr(1)).Interior.ColorIndex = 3
- Cells(j, 3) = Columns(9).Find(arr(1), lookat:=xlWhole).Offset(0, 1)
- Cells(j, 2).Characters(Start:=1 + Len(arr(0)), Length:=Len(arr(1))).Font.ColorIndex = 3
- End If
- End If
- End If
- End If
- Next j
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|