|
本帖最后由 tyxvba7529 于 2019-1-15 17:06 编辑
写得不好,试下是否符合- Sub test()
- Dim srr As String
- Dim x As Integer, y As Integer
- Set d = CreateObject("scripting.dictionary")
- Cells.Font.ColorIndex = xlAutomatic
- arr = [a1].CurrentRegion
- For x = 2 To UBound(arr, 1)
- For y = 1 To UBound(arr, 2)
- If y = 10 Or y = 11 Then
- If arr(x, y) = "未连通" Or arr(x, y) = "空白" Or _
- arr(x, y) = "其他" Or arr(x, y) = "个人" Then
- chuli x, y, srr
- End If
- End If
-
- If y = 2 Or y = 3 Then
- If Len(arr(x, y)) > 0 Then
- d(arr(x, y)) = d(arr(x, y)) + 1
- End If
- End If
-
- Next
- Next
- For x = 2 To UBound(arr, 1)
- For y = 1 To UBound(arr, 2)
- If y = 2 Or y = 3 Then
- If arr(x, y) <> "" Then
- If d(arr(x, y)) > 1 Then
- chuli x, y, srr
- End If
- End If
- End If
- Next
- Next
- If Len(srr) > 0 Then
- Range(srr).Font.Color = vbRed
- End If
- End Sub
- Function chuli(x As Integer, y As Integer, sr As String)
- If sr = "" Then
- sr = Cells(x, y).Address(0, 0)
- Else
- sr = sr & "," & Cells(x, y).Address(0, 0)
- End If
- If Len(sr) > 250 Then
- Range(sr).Font.Color = vbRed
- sr = ""
- End If
- End Function
复制代码 |
|