|
参与一下。。。
- Sub ykcbf() '//2024.8.23
- Application.ScreenUpdating = False
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- With Sheets("离职花名册")
- r = .Cells(Rows.Count, 3).End(3).Row
- arr = .[c1].Resize(r, 1)
- For i = 2 To UBound(arr)
- d(arr(i, 1)) = ""
- Next
- End With
- With Sheets("在职花名册")
- r = .Cells(Rows.Count, 3).End(3).Row
- arr = .[c1].Resize(r, 1)
- For i = 2 To UBound(arr)
- d1(arr(i, 1)) = ""
- Next
- End With
- For Each sht In Sheets
- If InStr(sht.Name, "汇总") Then
- With sht
- r = .Cells(Rows.Count, 1).End(3).Row
- arr = .[a1].Resize(r, 11).Value
- .Cells.Font.ColorIndex = 0
- For i = 3 To UBound(arr)
- If arr(i, 3) <> Empty And arr(i, 3) <> " 门店" Then
- For j = 4 To 10
- If arr(i, j) <> Empty Then
- s = arr(i, j)
- Set Rng = .Cells(i, j)
- If InStr(s, ",") = 0 Then
- If d.exists(s) Then Rng.Font.ColorIndex = 3
- Else
- st = Split(s, ",")
- For x = 0 To UBound(st)
- s1 = st(x)
- l = InStr(s, s1)
- If d.exists(s1) Then Rng.Characters(l, Len(s1)).Font.ColorIndex = 3
- Next
- End If
- If InStr(s, ",") = 0 Then
- If Rng.Font.ColorIndex <> 3 Then
- If d1.exists(s) Then Rng.Font.ColorIndex = 10
- End If
- Else
- st = Split(s, ",")
- For x = 0 To UBound(st)
- s1 = st(x)
- l = InStr(s, s1)
- If Rng.Characters(l, Len(s1)).Font.ColorIndex <> 3 Then
- If d1.exists(s1) Then Rng.Characters(l, Len(s1)).Font.ColorIndex = 10
- End If
- Next
- End If
- End If
- Next
- End If
- Next
- End With
- End If
- Next
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
|