【VBA】AI优化批量删除Excel删除线文本2

三年前，根据搜索加手搓，分享了一篇批量删除Excel删除线文本的程序的文章，现在有AI了，何不让AI来帮我润色润色，顺便小编也学学AI编程的结构是什么样的？话不多说，直接放AI润色后的代码，需要自取，大家甚至可以在此基础上继续优化，添加一些自己的需求。（本篇优化的是第二部分代码）

Sub 批量删除删除线文本并删除空行()    Dim i As Long, j As Long, k As Long    Dim RgA As Range, CellA As Range    Dim StrA As String    Dim r As Long, c As Long    Dim AllEmpty As Boolean    Dim ws As Worksheet    ' 获取当前活动工作表    Set ws = ThisWorkbook.ActiveSheet    ' 确定处理范围（使用已用区域，若覆盖不全可手动修改j,k）    With ws        j = .UsedRange.Rows.Count        k = .UsedRange.Columns.Count        If j = 0 Or k = 0 Then Exit Sub        Set RgA = .Range(.Cells(1, 1), .Cells(j, k))    End With    ' 关闭屏幕更新与自动计算，提升执行速度    Application.ScreenUpdating = False    Application.Calculation = xlCalculationManual    ' 遍历范围内所有单元格    For Each CellA In RgA        ' 仅处理非数字的单元格（保留原逻辑）        If Not IsNumeric(CellA.Value) Then            ' ① 若整个单元格字体均为删除线 → 直接清空，跳过字符遍历            If CellA.Font.Strikethrough Then                CellA.Value = ""            Else                ' ② 否则逐个字符检查，只保留没有删除线的字符                StrA = ""                For i = 1 To Len(CellA.Value)                    With CellA.Characters(i, 1)                        If Not .Font.Strikethrough Then                            StrA = StrA & .Text                        End If                    End With                Next i                CellA.Value = StrA            End If            ' 还原单元格背景与字体颜色为默认            CellA.Interior.Pattern = xlNone            CellA.Font.ColorIndex = xlAutomatic        End If    Next CellA    ' 删除空行（从下往上逐行检查，避免行号错乱）    For r = j To 1 Step -1        AllEmpty = True        For c = 1 To k            ' 若某行任一单元格有非空内容（含空格视为空）            If Len(Trim(ws.Cells(r, c).Value)) > 0 Then                AllEmpty = False                Exit For            End If        Next c        If AllEmpty Then            ws.Rows(r).Delete        End If    Next r    ' 恢复屏幕更新与自动计算    Application.ScreenUpdating = True    Application.Calculation = xlCalculationAutomatic    MsgBox "删除线文本已清除，空行已删除！", vbInformation, "完成"End Sub

代码含义详解

1. 功能概述

清除删除线文本：遍历工作表的已用区域，对每个非数字单元格，移除所有带有“删除线”格式的字符，保留无删除线的字符。
自动删除空行：处理完成后，检查每一行是否所有单元格都为空（Trim后长度为0），若是则从下往上删除整行。

2. 主要优化点

优化项	说明
整体删除线快速判定	若单元格整体字体设为删除线（`CellA.Font.Strikethrough = True`），则无需遍历每个字符，直接清空，大幅提升速度。
关闭自动计算	临时将计算模式设为手动，避免每次单元格修改触发重算，提升性能。
恢复错误处理	移除了宽松的 `On Error Resume Next`，仅在可能出错的字符遍历部分使用局部容错（代码中未显式，但可通过外围容错增强）。
删除空行逻辑	从最后一行向上遍历，确保删除行后不影响上方行的索引；检查范围与初始 `k` 列保持一致。
明确工作表引用	使用 `ws` 变量代替多次 `ThisWorkbook.ActiveSheet`，提高可读性。