函数大神在哪里

txwdhao

重号检查，重复的号筛选出来，并且显示红色--求助大神

txwdhao

求助，别沉呀。在线求助。。。

象山海鲜

函数不能改变单元格字体颜色
现转到vba板块

ykcbf1100

VBA做一个，正则＋字典，附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf() '//2024.4.10
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         arr = .[a1].Resize(r, 1)
   
6.         Set reg = CreateObject("VBScript.RegExp")
   
7.         .Cells.Font.ColorIndex = 0
   
8.         With reg
   
9.             .Pattern = "[a-zA-Z0-9]+"
   
10.             .Global = True
    
11.             For i = 1 To r
    
12.                 s = arr(i, 1)
    
13.                 Set mh = .Execute(s)
    
14.                 For Each k In mh
    
15.                     d(k.Value) = d(k.Value) + 1
    
16.                 Next
    
17.             Next
    
18.         End With
    
19.         For Each k In d.keys
    
20.             t = d(k)
    
21.             If t > 1 Then
    
22.                 For i = 1 To r
    
23.                     x = InStr(arr(i, 1), k)
    
24.                     If x Then
    
25.                         .Cells(i, 1).Characters(x, Len(k)).Font.ColorIndex = 3
    
26.                     End If
    
27.                 Next
    
28.             End If
    
29.         Next
    
30.     End With
    
31. End Sub
    

复制代码

yynrzwh

Sub test()

Set d = CreateObject("scripting.dictionary")
With Sheet1
    .Range("a1").CurrentRegion.Font.ColorIndex = 0
    ar = .Range("a1").CurrentRegion
    For i = 1 To UBound(ar)
        s = ar(i, 1)
        s = Replace(s, "，", "-")
        s = Replace(s, "~", "-")
        t = Split(s, "-")
        For x = 0 To UBound(t)
            If Not d.exists(t(x)) Then
                d(t(x)) = Array(i, InStr(s, t(x)), Len(t(x)))
            Else
                a = d(t(x))
                .Cells(a(0), 1).Characters(a(1), a(2)).Font.ColorIndex = 3
                st = InStr(s, t(x))
                .Cells(i, 1).Characters(st, a(2)).Font.ColorIndex = 3
            End If
        Next
    Next
   
End With
Set d = Nothing
End Sub

txwdhao

yynrzwh 发表于 2024-4-10 10:52
Sub test()

Set d = CreateObject("scripting.dictionary")

。这个好像还不行

txwdhao

ykcbf1100 发表于 2024-4-10 09:51
参与一下。。。

，这种格式还不行

txwdhao

ykcbf1100 发表于 2024-4-10 09:51
VBA做一个，正则＋字典，附件供参考。。。

，这个还不能准备的实行

ykcbf1100

txwdhao 发表于 2024-4-21 13:39
，这种格式还不行

你CJ3只存在一次，哪来重复啊