单元格内的文字隔行变色

aman1516 · 发表于 2017-10-26 21:52

本帖最后由 aman1516 于 2017-11-6 21:14 编辑

将单元格内指定的内容变色可用正则处理，但对于同一单无格内任意“多行”内容的，想隔行变色，请教如何修改代码？
单元格内是用“Alt”+“Enter”换行
详见附件：

单元格内的文字隔行变色.rar (20.24 KB, 下载次数: 26) 谢谢！

chxw68 · 发表于 2017-10-27 09:28

Sub test()
Dim r%, i%
Dim arr, brr
Dim reg As New RegExp
With reg
.Global = True
.Pattern = ".+?(\n|$)"
End With
With Worksheets("隔行")
r = .Cells(.Rows.Count, 2).End(xlUp).Row
For i = 2 To r
Set mh = reg.Execute(.Cells(i, 2).Value)
With .Cells(i, 2)
.Font.ColorIndex = 0
For j = 1 To mh.Count - 1 Step 2
With .Characters(Start:=mh(j).FirstIndex, Length:=mh(j).Length + 1).Font
.ColorIndex = 3
End With
Next
End With
Next
End With
End Sub

复制代码

chxw68 · 发表于 2017-10-27 09:29

单元格内也可以使用正则表达式。

aman1516 · 发表于 2017-10-27 12:56

chxw68 发表于 2017-10-27 09:29
单元格内也可以使用正则表达式。

非常感谢，\n是回车，|$是指取后面回车后面的数据么

aman1516 · 发表于 2017-11-6 21:29

添加了新条件，若是对包含有关键字（多个之任一个）的行变色，怎样设置参数呢？
详见附件：

单元格内的文字隔行变色.rar (17.85 KB, 下载次数: 19)

aman1516 · 发表于 2017-12-20 12:28

象下面这样的混合数据出错了，再请老师看下如何修改：
木/1/木04[A（5）1214*1029]；木/1/木04[A（13）1214*1029]；木/1/木04[A（3）1514*1029]；木/1/木06[A（2)901*906]；木/1/木06[A（6）1173*221;A（8）1173*221]；木/1/木06[A（4）1214*221;A（12）1214*221]；木/1/木07[A（1）1514*221;A（7）1173*221]；木/1/木14[A（10）1173*1984]；木/1/木14[A（9）1173*1984]；木/1/木14[A（11）1173*1984]；框/1/G09[1框2条]；框/1/G06[1条1框 2-1(挡水）]；框/1/G06[1条1框 2-2]；条/1/H08[1框2条3-3（挡水）]；条/1/H08[1框2条3-1]；条/1/H08[4条 4-2]；条/1/H08[100*50*3.0方管H2340*2支]；条/1/H08[120*120*3.0方管H90*8支;100系列90°转角H2340*1支]；条/1/H07[4条4-3]；条/1/H07[1条1框2-1（挡水）]；条/1/H07[1条1框2-2]；条/1/H07[4条 4-4]；纱/1/D03[]；纱/1/D03[]；纱/1/D03[]；纱/1/D03[]；纱/1/D03[]
详见附件

单元格内的文字隔行变色.rar (21.56 KB, 下载次数: 15)

aman1516 · 发表于 2017-12-21 10:44

chxw68 发表于 2017-10-27 09:28

褚老师能否抽空再看下

chxw68 · 发表于 2017-12-21 10:54

aman1516 发表于 2017-12-21 10:44
褚老师能否抽空再看下

一是楼主把我写的代码不知道抛弃到什么地方了，叫我如何做答？二是你是以Alt+Enter来区分每行的，但6楼数据就没有以Alt+Enter换行，如何变色？

aman1516 · 发表于 2017-12-21 12:34

chxw68 发表于 2017-12-21 10:54
一是楼主把我写的代码不知道抛弃到什么地方了，叫我如何做答？二是你是以Alt+Enter来区分每行的，但6楼数 ...

不好意思，这个还是最初文件数据，里面有三个工作表，“隔行”工作表中，回车隔行变色的问题用您的代码已成功解决，非常感谢！
现在是原来“指定”工作表中，将[]内的内容变色的，B3~B12的数据都正确，但B14对应上述内容的数据却出错了以下代码不知如何修改；
Sub test()
Dim reg, mA&, mB&, mC&, mD&, strA, s, k
Set reg = CreateObject("vbscript.regexp")
With reg
      .Global = True
      .Pattern = "\[.*?\]"
End With
For mA = 3 To Cells(Rows.Count, "b").End(xlUp).Row
      If reg.test(Cells(mA, "b").Value) Then
         strA = ""
         Set s = reg.Execute(Cells(mA, "b").Value)
         For k = 0 To s.Count - 1
            strA = strA & s(k)
         Next
      End If
      mB = Len(Cells(mA, "b"))
      For mC = 1 To mB
         If InStr(strA, Mid(Cells(mA, "b"), mC, 1)) Then
            Cells(mA, "b").Characters(mC, 1).Font.ColorIndex = 3
         End If
      Next
Next
End Sub

另行，工作表3的按关键字突出颜色的情况也不知如何处理？

aman1516 · 发表于 2017-12-21 22:10

本帖最后由 aman1516 于 2017-12-21 23:13 编辑

换了个处理方式，基本解决：

Sub test0()
Dim r%, i%
Dim reg As New RegExp
With reg
.Global = True
.Pattern = "\[(.*?)\]"
End With
With Worksheets("指定")
r = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("B1:B" & r).Font.ColorIndex = 0
For i = 1 To r
Set mh = reg.Execute(.Cells(i, 2).Value)
If mh.Count > 0 Then
For k = 0 To mh.Count - 1
.Cells(i, 2).Characters(Start:=mh(k).FirstIndex + 1, Length:=mh(k).Length).Font.ColorIndex = 3
Next
End If
Next
End With
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 单元格内的文字隔行变色

点评

评分