|
参与一下。。。- Sub ykcbf() '//2024.3.20
- Application.ScreenUpdating = False
- Set d = CreateObject("scripting.dictionary")
- lie = Val(InputBox("请输入你要格式化的列号" & Chr(10) & Chr(10) & "比如: 1,2,3等", "温馨提示"))
- If lie = 0 Then MsgBox "没有输入列号!": Exit Sub
- r = Cells(Rows.Count, 5).End(3).Row
- arr = Range("a1:h" & r)
- ActiveSheet.UsedRange.Offset(4).Interior.ColorIndex = 0
- For i = 5 To UBound(arr)
- s = arr(i, 5)
- If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
- d(s)(i) = i
- Next
- For Each k In d.keys
- m = 0
- For i = 5 To UBound(arr)
- If arr(i, 5) = k Then
- For Each kk In d(k).keys
- m = m + 1
- If m > 1 Then
- Cells(kk, lie).Interior.ColorIndex = 6
- End If
- Next
- Exit For
- End If
- Next
- Next
- Application.ScreenUpdating = True
- End Sub
复制代码
|
评分
-
1
查看全部评分
-
|