求相同字符变红色，谢谢 - 编程论坛

#2

阳光上的桥2023-05-29 09:43

算法并不复杂，建议自己写写看，有疑问再讨论，这样成长更快：

第一步、把C列内容转换为字典
需要双重循环对C列的所有单元格、单元格的没用字符，添加到字典里面 dic(ch) = True

第二步、对E列进行标红
也是双重循，外层对没用单元格，内层对每个单元格的每个字符，如果在字典中就标记颜色

#3

阳光上的桥2023-05-29 09:58

下面的代码仅供参考，建议先思考了再看：

程序代码：

Option Explicit

Sub x()
    Dim dic As Object
    Dim arr, i&, j&, s$, c$
    arr = ActiveSheet.UsedRange
    '第一步做字典
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr)
        s = Trim(arr(i, 1)) '1=》A列
        If s <> "" Then
            For j = 1 To Len(s)
                c = Mid(s, j, 1)
                dic(c) = True
            Next j
        End If
    Next i
    '第二步做标记
    For i = 1 To UBound(arr)
        s = arr(i, 2) '2=》B列
        If s <> "" Then
            For j = 1 To Len(s)
                c = Mid(s, j, 1)
                If dic(c) Then Cells(i, 2).Characters(j, 1).Font.Color = RGB(255, 0, 0)
            Next j
        End If
    Next i
End Sub

这是示例数据和运行结果，故意使用的A、B列，希望能举一反三，代码里面的还有一处是固定B列的没用注释，看看能否找到并修改实际数据的E列。

只有本站会员才能查看附件，请登录

#4

梦星守护神2023-05-29 11:03

版主你好,首先感谢版主的帮助,刚才操作了一下,发现了一点小问题:A例并没有数字5和12,B列5和12也变红色了,估计版主忘了区分数字的位数.还有B列若有"=""各"这两个字符,那么这两个字符后面的数字不用变色,感觉有点复杂,不知道能不能实现.

只有本站会员才能查看附件，请登录

#5

阳光上的桥2023-05-29 12:52

有说数字串作为一个字符吗，我好像没看见，逻辑也很简单，就是用自定义的split2函数来拆分文本为数组，把连续的数字作为一个整体，内层循环for j修改为for each t，完整代码如下：

程序代码：

Option Explicit

Sub x()
    Dim dic As Object
    Dim arr, i&, j&, s$, t
    arr = ActiveSheet.UsedRange
    '第一步做字典
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr)
        s = Trim(arr(i, 1)) '1=》A列
        If s <> "" Then
            For Each t In split2(s)
                dic(t(1)) = True
            Next t
        End If
    Next i
    '第二步做标记
    For i = 1 To UBound(arr)
        s = arr(i, 2) '2=》B列
        If s <> "" Then
            For Each t In split2(s)
                If t(1) = "=" Or t(1) = "各" Then Exit For
                If dic(t(1)) Then Cells(i, 2).Characters(t(0), Len(t(1))).Font.Color = RGB(255, 0, 0)
            Next t
        End If
    Next i
End Sub

Function split2(s$) '把字符串拆分为字符数组，数字作为整体
    Dim m&, arr(), i&, n&, c$, c2$, ci&, si$
    m = Len(s)
    n = 0
    ci = 0
    si = ""
    For i = 1 To m
        c = Mid(s, i, 1)
        si = si & c
        If i = m Then c2 = "" Else c2 = Mid(s, i + 1, 1)
        If ci = 0 Then ci = i
        If notNumber(c) Or notNumber(c2) Or i = m Then
            ReDim Preserve arr(0 To n)
            arr(n) = Array(ci, si)
            n = n + 1
            si = ""
            ci = 0
        End If
    Next i
    split2 = arr
End Function

Function notNumber(c$) '判断字符c是否数字
    notNumber = c < "0" Or c > "9"
End Function

我很想知道能看明白代码吗，而不代码执行了是什么效果