修改需求：快速统计和标注单元格2种颜色red 或者Black（忽略标点符号和数字）

追风少年丶斌

Sub JudgeColor()
    Dim rng As Range, i As Long, j As Long, k As Byte, str As String, strColor
    Dim blnWzRed As Boolean, blnWzBlack As Boolean, blnBdRed As Boolean
    Dim blnBdBlack As Boolean, blnNoRed As Boolean, blnNoBlack As Boolean
    Dim rg As Range, Bd As String
    '自定义需要过滤的标点符号，Chr(34)表示英文状态下的双引号
    Bd = ",。？；：“’”‘！!'?，.、" & Chr(34)
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    Set rng = Intersect(ActiveSheet.UsedRange, rng)
    For i = 2 To rng.Rows.Count
        blnWzRed = False
        blnWzBlack = False
        blnBdRed = False
        blnBdBlack = False
        blnNoRed = False
        blnNoBlack = False
        Set rg = rng.Cells(i, 1)
        For j = 1 To Len(rg.Value)
            With rg.Characters(Start:=j, Length:=1)
                str = .Text
                strColor = .Font.ColorIndex
            End With
            If InStr(1, Bd, str) > 0 Then
                If strColor = 3 Then blnBdRed = True Else blnBdBlack = True
            ElseIf IsNumeric(str) Then
                If strColor = 3 Then blnNoRed = True Else blnNoBlack = True
            Else
                If strColor = 3 Then blnWzRed = True Else blnWzBlack = True
            End If
            If blnWzRed And blnWzBlack Then Exit For
        Next j
        If blnWzRed And blnWzBlack Then
            rng.Cells(i, 2).Value = "mixed"
        ElseIf blnWzRed Then
            If Not blnBdBlack And Not blnNoBlack Then
                rng.Cells(i, 2).Value = "red"
            ElseIf blnBdBlack And blnNoBlack Then
                rng.Cells(i, 2).Value = "red (忽略标点符号和数字颜色)"
            ElseIf blnBdBlack Then
                rng.Cells(i, 2).Value = "red (忽略标点符号颜色)"
            Else
                rng.Cells(i, 2).Value = "red (忽略数字颜色)"
            End If
        ElseIf blnWzBlack Then
            If Not blnBdRed And Not blnNoRed Then
                rng.Cells(i, 2).Value = "black"
            ElseIf blnBdRed And blnNoRed Then
                rng.Cells(i, 2).Value = "black (忽略标点符号和数字颜色)"
            ElseIf blnBdRed Then
                rng.Cells(i, 2).Value = "black (忽略标点符号颜色)"
            Else
                rng.Cells(i, 2).Value = "black (忽略数字颜色)"
            End If
        End If
    Next i
End Sub

smiletwo

qlmgu 发表于 2023-2-26 15:40
那也很好。可以帮我加入返回结果到具体行、忽略标点和数字的颜色吗？真太感激了。

提到具体字符，就不是单元格整体。

qlmgu

smiletwo 发表于 2023-2-26 19:06
提到具体字符，就不是单元格整体。

感谢老师耐心地启发我这个外行。就是我的想法确实不符合实际。谢谢smiletwo老师。

qlmgu

追风少年丶斌 发表于 2023-2-26 17:33
Sub JudgeColor()
    Dim rng As Range, i As Long, j As Long, k As Byte, str As String, strColor
   ...

回复老师：您的程序测试模拟数据，结果完全正确，完美。我现在去测试3.5K文本字数比较多的数据。如果可以顺利完成，我再向老师报告。

zxskyqq

追风少年丶斌 发表于 2023-2-26 17:33
Sub JudgeColor()
    Dim rng As Range, i As Long, j As Long, k As Byte, str As String, strColor
   ...

你这像是chatGPT的代码

追风少年丶斌

zxskyqq 发表于 2023-2-26 21:17
你这像是chatGPT的代码

第一个是ChatGPT的代码，后面是我自己修改了一下

qlmgu

追风少年丶斌 发表于 2023-2-26 21:44
第一个是ChatGPT的代码，后面是我自己修改了一下

无论如何都感谢您的帮助。软件还在运行，超过1个小时了（再次报告：最后没有结果）。是我的要求不符合实际。抱歉了各位老师。

追风少年丶斌

qlmgu 发表于 2023-2-26 21:48
无论如何都感谢您的帮助。软件还在运行，超过1个小时了（再次报告：最后没有结果）。是我的要求不符合实 ...

可以把代码里面再加一个判断，当满足某几个条件之后跳出循环可以大大加快运行的速度

qlmgu

追风少年丶斌 发表于 2023-2-26 22:08
可以把代码里面再加一个判断，当满足某几个条件之后跳出循环可以大大加快运行的速度

可以帮我写一下吗 谢谢了

追风少年丶斌

qlmgu 发表于 2023-2-26 23:28
可以帮我写一下吗 谢谢了

If blnWzRed And blnWzBlack Then Exit For '在这一句的后面，加上以下两句
            If blnWzRed And blnBdBlack And blnNoBlack Then Exit For
            If blnWzBlack And blnBdRed And blnNoRed Then Exit For