双击单元格，进行索引添色，谢谢liulang0808和cidanji老师！

lhj323323

老师：

不知如下效果，能否实现？


求助.rar (7.57 KB, 下载次数: 7)

2023-12-11 23:20 上传

点击文件名下载附件

cidanji

求助.rar (13.21 KB, 下载次数: 10)

2023-12-12 07:34 上传

点击文件名下载附件

liulang0808

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.CountLarge <> 1 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    If Target.Row = 1 Then Exit Sub
    If Len(Target) * Len(Target.Offset(0, 1)) = 0 Then Exit Sub
    If InStr(Target.Offset(0, 1), ",") = 0 Then
        str1 = Target.Offset(0, 1)
    Else
        arr = Split(Target.Offset(0, 1), ",")
        For j = 0 To UBound(arr)
            For i = j + 1 To UBound(arr)
                If Len(arr(i)) > Len(arr(j)) Then
                    tm = arr(i)
                    arr(i) = arr(j)
                    arr(j) = tm
                End If
            Next i
        Next j
        str1 = Join(arr, "|")
    End If
    Application.ScreenUpdating = False
    r = Cells(Rows.Count, 2).End(3).Row
    arr = [b1].Resize(r)
    Range("b2:b" & r).Font.ColorIndex = 0
    With CreateObject("vbscript.regexp")
        .Pattern = str1
        .Global = True
        For j = 2 To UBound(arr)
            For Each m In .Execute(arr(j, 1))
                Cells(j, 2).Characters(m.FirstIndex + 1, m.Length).Font.ColorIndex = 3
            Next
        Next j
    End With
    Application.ScreenUpdating = True
End Sub

liulang0808

求助1.zip (12.28 KB, 下载次数: 21)

2023-12-12 07:49 上传

点击文件名下载附件

供参考。。。。。

lhj323323

cidanji 发表于 2023-12-12 07:34

谢谢老师回复

.Pattern = "汽车配件|新能源车|减速器"
这句，不该纳入到语句里，这是动态取值。
随光标点选的【A列的单元格】的不同，而变化的。

lhj323323

liulang0808 发表于 2023-12-12 07:50
供参考。。。。。

谢谢老师回复


要报错

liulang0808

lhj323323 发表于 2023-12-12 08:19
谢谢老师回复

你贴的图片，显示不出来，是源文件报错的吗？附件上传看看吧

lhj323323

liulang0808 发表于 2023-12-12 07:50
供参考。。。。。

我去掉第1句，就行了，能运行成功！

多谢版主老师！

lhj323323

liulang0808 发表于 2023-12-12 08:20
你贴的图片，显示不出来，是源文件报错的吗？附件上传看看吧

就是用的本贴第4楼，您提供的附件。
我只字未动。

但我现在删除第一句
If Target.CountLarge <> 1 Then Exit Sub
就测试成功了

有可能是CountLarge函数的原因
因为我提供的列，只有AB两列，不会有C列的。

lhj323323

liulang0808 发表于 2023-12-12 08:20
你贴的图片，显示不出来，是源文件报错的吗？附件上传看看吧

嗯，应该是版本问题。

没关系，我能搞明白问题所在，就足够了。
而且第一句，就是判断最大列数吗？
如果我的数据源，只有2列，就不必担心这一句了。