标示相同数

陈瑞云

标示相同数 标示相同数.rar (7.18 KB, 下载次数: 11)

2017-8-17 09:07 上传

点击文件名下载附件

凌空一羽

1. Sub lkyy()
   
2. Dim Rng As Range, j As Byte
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. ar = Range("ax100:bg100")
   
5. For j = 1 To 10
   
6.     If ar(1, j) <> "" Then d(ar(1, j)) = ""
   
7. Next
   
8. For Each Rng In Range("ax98:bg98")
   
9.     a = Len(Rng.Value)
   
10.     If a Then
    
11.         If a = 1 Then
    
12.             If d.exists(Rng.Value) Then Rng.Font.Color = vbRed
    
13.         Else
    
14.             For j = 1 To a
    
15.                 b = Mid(Rng.Value, j, 1)
    
16.                 If d.exists(b) Then Rng.Characters(j, 1).Font.Color = vbRed
    
17.             Next
    
18.         End If
    
19.     End If
    
20. Next
    
21. Set d = Nothing
    
22. End Sub

复制代码

chxw68

1. Sub test()
   
2.   Dim r%, i%, c%, j%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Dim reg As New RegExp
   
6.   Set d = CreateObject("scripting.dictionary")
   
7.   With reg
   
8.     .Global = True
   
9.   End With
   
10.   With Worksheets("sheet1")
    
11.     arr = .Range("ax100:bg100")
    
12.     For j = 1 To UBound(arr, 2)
    
13.       If Len(arr(1, j)) <> 0 Then
    
14.         d(arr(1, j)) = ""
    
15.       End If
    
16.     Next
    
17.     reg.Pattern = Join(d.keys, "|")
    
18.     For j = 50 To 59
    
19.       If Len(.Cells(98, j)) <> 0 Then
    
20.         Set mh = reg.Execute(.Cells(98, j).Value)
    
21.         If mh.Count > 0 Then
    
22.           For k = 0 To mh.Count - 1
    
23.             .Cells(98, j).Characters(Start:=mh(k).FirstIndex + 1, Length:=mh(k).Length).Font.ColorIndex = 3
    
24.           Next
    
25.         End If
    
26.       End If
    
27.     Next
    
28.   End With
    
29. End Sub
    

复制代码

chxw68

供楼主参考。

Chip_Kenny

try this:
Sub zz()
Dim ar, d As Object, k, t, rng As Range
Set d = CreateObject("scripting.dictionary")
ar = [ax100:bg100]
For Each t In ar
    If Len(t) Then d(t) = ""
Next
Set rng = [ax98:bg98]
ar = rng
For i = 1 To UBound(ar)
    For j = 1 To UBound(ar, 2)
        For jj = 1 To Len(ar(i, j))
            If d.exists(Mid(ar(i, j), jj, 1)) Then rng(i, j).Characters(jj, 1).Font.Color = vbRed
        Next
    Next
Next

jnsxmt

Option Explicit

Sub test()
    Dim m&, n&, k&
    Dim arr, brr
    arr = Range("ax100:bg100")
    For m = LBound(arr, 2) To UBound(arr, 2)
        For n = 50 To 59
            If arr(1, m) <> "" Then
                k = InStr(1, Cells(98, n).Text, CStr(arr(1, m)), 1)
                If k <> 0 Then
                    Cells(98, n).Characters(k, Len(arr(1, m))).Font.ColorIndex = 3
                End If
            End If
        Next
    Next
End Sub