|
发表于 2016-9-23 17:00
|
显示全部楼层
本楼为最佳答案
- Option Explicit
- Sub test1()
- Dim Ends%, lstRow%, irow%, irow1%
- Dim arrSrc
- Dim objdic As Object
- Set objdic = CreateObject("scripting.dictionary")
- Ends = Cells(Rows.Count, 1).End(3).Row
- lstRow = Cells(Rows.Count, 5).End(3).Row
- arrSrc = Range("a2:b" & Ends).Value
- For irow = 1 To UBound(arrSrc)
- If Len(arrSrc(irow, 1) & arrSrc(irow, 2)) Then
- If Not objdic.exists(arrSrc(irow, 1) & "," & arrSrc(irow, 2)) Then
- objdic.Add arrSrc(irow, 1) & "," & arrSrc(irow, 2), ""
- End If
- End If
- Next
- For irow1 = 2 To lstRow
- If Len(Cells(irow1, 5) & Cells(irow1, 6)) Then
- If Not objdic.exists(Cells(irow1, 5) & "," & Cells(irow1, 6)) Then
- Range(Cells(irow1, 5), Cells(irow1, 6)).Interior.ColorIndex = 3
- End If
- End If
- Next
- Set objdic = Nothing
- Erase arrSrc
- Call test2
- End Sub
- Sub test2()
- Dim Ends%, lstRow%, irow%, irow1%
- Dim arrSrc
- Dim objdic As Object
- Set objdic = CreateObject("scripting.dictionary")
- Ends = Cells(Rows.Count, 5).End(3).Row
- lstRow = Cells(Rows.Count, 1).End(3).Row
- arrSrc = Range("E2:F" & Ends).Value
- For irow = 1 To UBound(arrSrc)
- If Len(arrSrc(irow, 1) & arrSrc(irow, 2)) Then
- If Not objdic.exists(arrSrc(irow, 1) & "," & arrSrc(irow, 2)) Then
- objdic.Add arrSrc(irow, 1) & "," & arrSrc(irow, 2), ""
- End If
- End If
- Next
- For irow1 = 2 To lstRow
- If Len(Cells(irow1, 1) & Cells(irow1, 2)) Then
- If Not objdic.exists(Cells(irow1, 1) & "," & Cells(irow1, 2)) Then
- Range(Cells(irow1, 1), Cells(irow1, 2)).Interior.ColorIndex = 3
- End If
- End If
- Next
- Set objdic = Nothing
- Erase arrSrc
- End Sub
复制代码 |
|