| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 610 人关注过本帖
标题:求相同字符变红色,谢谢
只看楼主 加入收藏
梦星守护神
Rank: 1
等 级:新手上路
帖 子:11
专家分:0
注 册:2023-5-15
结帖率:100%
收藏
已结贴  问题点数:10 回复次数:4 
求相同字符变红色,谢谢
图片附件: 游客没有浏览图片的权限,请 登录注册
搜索更多相关主题的帖子: 相同 字符 
2023-05-27 21:51
阳光上的桥
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:38
帖 子:129
专家分:772
注 册:2023-1-12
收藏
得分:10 
算法并不复杂,建议自己写写看,有疑问再讨论,这样成长更快:

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

第二步、对E列进行标红
也是双重循,外层对没用单元格,内层对每个单元格的每个字符,如果在字典中就标记颜色
2023-05-29 09:43
阳光上的桥
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:38
帖 子:129
专家分:772
注 册:2023-1-12
收藏
得分:0 
下面的代码仅供参考,建议先思考了再看:

程序代码:
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列。
图片附件: 游客没有浏览图片的权限,请 登录注册
2023-05-29 09:58
梦星守护神
Rank: 1
等 级:新手上路
帖 子:11
专家分:0
注 册:2023-5-15
收藏
得分:0 
版主你好,首先感谢版主的帮助,刚才操作了一下,发现了一点小问题:A例并没有数字5和12,B列5和12也变红色了,估计版主忘了区分数字的位数.还有B列若有"=""各"这两个字符,那么这两个字符后面的数字不用变色,感觉有点复杂,不知道能不能实现.
图片附件: 游客没有浏览图片的权限,请 登录注册
2023-05-29 11:03
阳光上的桥
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:38
帖 子:129
专家分:772
注 册:2023-1-12
收藏
得分:0 
有说数字串作为一个字符吗,我好像没看见,逻辑也很简单,就是用自定义的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


我很想知道能看明白代码吗,而不代码执行了是什么效果
2023-05-29 12:52
快速回复:求相同字符变红色,谢谢
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.035556 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved