WPS VBA插件简单使用教程（一）

目的：F4:K10000单元格内中【】内容为红色

一：下载安装WPS VBA插件https://wwgh.lanzn.com/iXNP32ovr6ne

二：输入VBA代码

完整代码如下：

Sub OptimizedColorAllTextInBrackets()
    Dim targetRange As Range
    Dim cell As Range
    Dim text As String
    Dim startPos As Long, endPos As Long
    Dim arrBrackets() As Variant
    Dim i As Long
    
    ' 设置目标区域（F4:K10000），根据实际需求调整
    Set targetRange = Range("F4:K10000")
    
    ' 关闭所有可能影响性能的功能 
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .EnableAnimations = False
    End With
    
    ' 遍历目标区域中的非空单元格（减少循环次数）
    For Each cell In targetRange.SpecialCells(xlCellTypeConstants)
        text = cell.Value
        If InStr(text, "【") > 0 Then ' 仅处理包含括号的单元格
            cell.Font.Color = RGB(0, 0, 0) ' 重置整个单元格为黑色
            
            ' 使用数组记录所有括号位置（减少多次InStr调用）
            ReDim arrBrackets(1 To Len(text) \ 2)
            startPos = InStr(text, "【")
            i = 0
            
            Do While startPos > 0
                endPos = InStr(startPos + 1, text, "】")
                If endPos > startPos Then
                    i = i + 1
                    arrBrackets(i) = Array(startPos, endPos - startPos + 1)
                    startPos = InStr(endPos + 1, text, "【")
                Else
                    Exit Do
                End If
            Loop
            
            ' 批量设置颜色（减少Characters方法的重复调用）
            If i > 0 Then
                For startPos = 1 To i
                    With cell.Characters(arrBrackets(startPos)(0), arrBrackets(startPos)(1)).Font
                        .Color = RGB(255, 0, 0)
                    End With
                Next startPos
            End If
        End If
    Next cell
    
    ' 恢复系统设置 
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .EnableAnimations = True
    End With
End Sub

PS：延伸代码，单元格内出现0值时，单元格为空。

Sub OptimizedColorAllTextInBrackets()
    Dim targetRange As Range
    Dim cell As Range
    Dim text As String
    Dim startPos As Long, endPos As Long
    Dim arrBrackets() As Variant
    Dim i As Long
    
    ' 设置目标区域（F4:K10000）
    Set targetRange = Range("F4:K10000")
    
    ' 处理可能存在的空区域错误
    On Error Resume Next
    Set targetRange = targetRange.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    
    If targetRange Is Nothing Then Exit Sub
    
    ' 关闭所有可能影响性能的功能
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .EnableAnimations = False
    End With
    
    For Each cell In targetRange
        ' 处理0值单元格
        If IsNumeric(cell.Value) Then
            If cell.Value = 0 Then
                cell.ClearContents
                GoTo ContinueLoop
            End If
        ElseIf cell.Value = "0" Then
            cell.ClearContents
            GoTo ContinueLoop
        End If
        
        text = cell.Value
        If InStr(text, "【") > 0 Then
            cell.Font.Color = RGB(0, 0, 0)
            
            ReDim arrBrackets(1 To Len(text) \ 2)
            startPos = InStr(text, "【")
            i = 0
            
            Do While startPos > 0
                endPos = InStr(startPos + 1, text, "】")
                If endPos > startPos Then
                    i = i + 1
                    arrBrackets(i) = Array(startPos, endPos - startPos + 1)
                    startPos = InStr(endPos + 1, text, "【")
                Else
                    Exit Do
                End If
            Loop
            
            If i > 0 Then
                For startPos = 1 To i
                    With cell.Characters(arrBrackets(startPos)(0), arrBrackets(startPos)(1)).Font
                        .Color = RGB(255, 0, 0)
                    End With
                Next startPos
            End If
        End If
ContinueLoop:
    Next cell
    
    ' 恢复系统设置
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .EnableAnimations = True
    End With
End Sub

三：输入自动运行代码

完整代码如下：

' 在对应工作表（如 Sheet1）的代码模块中添加以下代码
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim affectedRange As Range
    Dim cell As Range
    
    ' 设置监控区域（与宏中的目标区域一致）
    Set affectedRange = Me.Range("F4:K10000")
    
    ' 检查是否有单元格在监控区域内被修改
    If Not Intersect(Target, affectedRange) Is Nothing Then
        ' 关闭事件和屏幕刷新防止递归和闪烁
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        
        ' 遍历所有被修改的单元格并调用处理函数
        For Each cell In Intersect(Target, affectedRange)
            ProcessCell cell
        Next cell
        
        ' 恢复设置
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If
End Sub

' 独立函数：处理单个单元格的括号颜色
Sub ProcessCell(ByVal cell As Range)
    Dim text As String
    Dim startPos As Long, endPos As Long
    Dim arrBrackets() As Variant
    Dim i As Long
    
    text = cell.Value
    cell.Font.Color = RGB(0, 0, 0)  ' 重置颜色
    
    ' 仅处理包含【的单元格
    If InStr(text, "【") > 0 Then
        ReDim arrBrackets(1 To Len(text) \ 2)
        startPos = InStr(text, "【")
        i = 0
        
        ' 记录所有括号位置
        Do While startPos > 0
            endPos = InStr(startPos + 1, text, "】")
            If endPos > startPos Then
                i = i + 1
                arrBrackets(i) = Array(startPos, endPos - startPos + 1)
                startPos = InStr(endPos + 1, text, "【")
            Else
                Exit Do
            End If
        Loop
        
        ' 批量设置颜色
        If i > 0 Then
            For startPos = 1 To i
                With cell.Characters(arrBrackets(startPos)(0), arrBrackets(startPos)(1)).Font
                    .Color = RGB(255, 0, 0)
                End With
            Next startPos
        End If
    End If
End Sub

四：表格另存为带宏的表格