[已解决]求标示数字的代码。

上清宫主

Sub test()
Dim ar()
Application.ScreenUpdating = 0
Range("b7").CurrentRegion = Range("b7").CurrentRegion.Value
i1% = [d65536].End(3).Row
ar = Range("b7:d" & i1).Value
For i1 = 1 To UBound(ar)
    For i2% = 1 To UBound(ar, 2)
        str1$ = Split(ar(i1, i2), ",")(1)
        For i3% = 1 To Len(str1)
            i4% = InStr(8, ar(i1, i2), Mid(str1, i3, 1))
            Do While i4
               Cells(i1 + 6, i2 + 1).Characters(Start:=i4, Length:=1).Font.Color = vbRed
               i4 = InStr(i4 + 1, ar(i1, i2), Mid(str1, i3, 1))
            Loop
        Next
    Next
Next
End Sub

yyyydddd8888

请测试：
标示.rar (11.92 KB, 下载次数: 10)

2013-12-23 21:51 上传

点击文件名下载附件

爱疯

现在只能手机看了。虽然不麻烦，但由于循环的不是数组，是单元格，所以觉得不会很快，在数据源特别大时。

爱疯

回个贴，才发现已有两个答案了

myexcel88

yyyydddd8888 发表于 2013-12-23 21:51
请测试：

代码很通用，就是sheet2中不能标示颜色。

yyyydddd8888

myexcel88 发表于 2013-12-24 08:33
代码很通用，就是sheet2中不能标示颜色。

因为sheet2中的数据是用公式得到的，所以不能标示颜色，如果要把它也标上颜色，可以先把公式的值转化为数值就可以了，也可以在运行代码时，用代码来转化。

myexcel88

yyyydddd8888 发表于 2013-12-24 09:36
因为sheet2中的数据是用公式得到的，所以不能标示颜色，如果要把它也标上颜色，可以先把公式的值转化为数 ...

可以在代码中加上转化的代码么？

上清宫主

myexcel88 发表于 2013-12-24 10:43
可以在代码中加上转化的代码么？

无视11楼？

yyyydddd8888

myexcel88 发表于 2013-12-24 10:43
可以在代码中加上转化的代码么？

可以

修改标示.rar (11.32 KB, 下载次数: 3)

2013-12-24 12:18 上传

点击文件名下载附件

1. Option Explicit
   
2. 
   
3. Sub 标注颜色()
   
4. Dim arr, brr, crr, st1$, s$, row1, i%, m As Byte, j As Byte, L As Byte, p As Byte
   
5.     Application.DisplayAlerts = False
   
6.     Application.ScreenUpdating = False
   
7.    For m = 1 To Sheets.Count
   
8.     With Sheets(m)
   
9.         row1 = .Range("B65536").End(xlUp).Row
   
10.         arr = .Range("a1:d1000")
    
11.          .Cells = ""
    
12.          .Range("a1").Resize(UBound(arr), 4) = arr
    
13.         For i = 1 To 1000
    
14.             For j = 2 To 4
    
15.                 If arr(i, j) <> "" And InStr(arr(i, j), ",") Then
    
16.                     s = arr(i, j)
    
17.                     st1 = Split(arr(i, j), ",")(1)
    
18.                     L = InStr(InStr(s, ",") + 1, s, ",") + 1
    
19.                     For p = L To Len(s)
    
20.                         If st1 Like "*" & Mid(s, p, 1) & "*" Then
    
21.                             .Cells(i, j).Characters(Start:=p, Length:=1).Font.ColorIndex = 3
    
22.                         End If
    
23.                     Next p
    
24.                 End If
    
25.             Next j
    
26.         Next i
    
27.     End With
    
28. Next m
    
29.     Application.DisplayAlerts = True
    
30.     Application.ScreenUpdating = True
    
31. End Sub
    
32. 
    
33. Sub 取消标注颜色()
    
34.     Cells.Font.ColorIndex = 0
    
35. End Sub
    

复制代码

chensir

yyyydddd8888 发表于 2013-12-24 12:12
可以

能用如果需要标示的数字或字符能通过输入框的方式输入就完美了