算法并不复杂,建议自己写写看,有疑问再讨论,这样成长更快:
第一步、把C列内容转换为字典
需要双重循环对C列的所有单元格、单元格的没用字符,添加到字典里面 dic(ch) = True
第二步、对E列进行标红
也是双重循,外层对没用单元格,内层对每个单元格的每个字符,如果在字典中就标记颜色
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
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