专栏名称: 完美Excel

Excel与VBA技术学习与实践

使用deepseek优化VBA代码

完美Excel · 公众号 · Excel · 2025-02-10 06:00

正文

学习Excel技术，关注微信公众号：

excelperfect

标签： AI ，大模型， deepseek ， VBA

今天试试看 deepseek 对 VBA 代码优化能力如何。我使用前面推送的一篇文章（详见：使用 VBA 快速删除间隔行）中的示例，我对 deepseek 提问如下：

在 Excel 中，因为行重复或者空行等原因，我需要每间隔一行删除一行。下面是我编写的 VBA 代码：

Sub DeleteAlternateRowsWithHeader()

Dim rng As Range

Dim cell As Range

Dim deleteCount As Long

Dim keepCount As Long

Dim i As Long

' 显示用于选择源数据区域的输入对话框

On Error Resume Next

Set rng = Application.InputBox(" 选择源数据区域 :", Type:=8)

On Error GoTo 0

If rng Is Nothing Then

MsgBox " 没有选择任何区域 .", vbExclamation

Exit Sub

End If

' 从第 3 行开始每隔一行删除一行 ( 标题行位于第一行 )

For i = rng.Rows.Count To 3 Step -1

If (i Mod 2) = 1 Then

rng.Rows(i).EntireRow.Delete

deleteCount = deleteCount + 1

Else

keepCount = keepCount + 1

End If

Next i

' 统计保留的行数 , 包括标题行和第 2 行

keepCount = keepCount + 2

' 显示程序运行后的信息

MsgBox " 删除的行数 : " & deleteCount & vbCrLf & " 保留的行数 : " & keepCount, vbInformation

End Sub

请帮我对这段代码进行优化。

deepseek 首先阅读了这段代码，然后给出了自己对这段代码的理解，并分析了代码存在的一些缺陷，例如可能会导致的错误、代码效率不高等，分析了要考虑的各种情形，并给出了优化点。最后， deepseek 给出了优化后的代码如下：

Sub DeleteAlternateRowsWithHeader() Dim ws As Worksheet Dim rng As Range Dim deleteRng As Range Dim startRow As Long Dim i As Long Dim totalRows As Long Dim deleteCount As Long
 ' 设置错误处理 On Error Resume Next Set rng = Application.InputBox("请选择数据区域（包含标题行）:", "区域选择", Type:=8) On Error GoTo 0
 ' 检查用户是否取消选择 If rng Is Nothing Then   MsgBox "操作已取消。", vbInformation   Exit Sub End If
 ' 初始化参数 Set ws = rng.Parent




    
 startRow = 3  ' 从区域内的第三行开始处理（跳过标题行和第二行） totalRows = rng.Rows.Count Application.ScreenUpdating = False
 ' 从下往上遍历，收集需要删除的行 For i = totalRows To startRow Step -1   If (i - startRow) Mod 2 = 0 Then  ' 数学优化：直接计算间隔行     If deleteRng Is Nothing Then       Set deleteRng = rng.Rows(i)     Else       Set deleteRng = Union(deleteRng, rng.Rows(i))     End If   End If Next i
  deleteCount = deleteRng.Rows.Count
 ' 一次性删除所有目标行 If Not deleteRng Is Nothing Then   deleteRng.EntireRow.Delete'  deleteCount = deleteRng.Rows.Count End If
 ' 恢复屏幕更新 Application.ScreenUpdating = True
 ' 显示统计信息（包含标题行和第二行） MsgBox "原始总行数: " & totalRows & vbCrLf & _   "删除的行数: " & deleteCount & vbCrLf & _   "保留的行数: " & totalRows - deleteCount, _   vbInformation, "操作完成"End Sub

但是，还是存在一个瑕疵，我稍微调整了一个，就是将循环中的语句：

deleteCount = deleteRng.Rows.Count

调整到了这个循环的上方，如上文的代码所示。

接着， deepseek 给出了优化亮点说明：

1. 效率提升：

使用 Union 收集所有待删除行后一次性删除，相比逐行删除效率提升 90%+

禁用屏幕刷新（ Application.ScreenUpdating = False ）避免闪烁

2. 逻辑优化：

使用数学公式 (i - startRow) Mod 2 = 0 精准定位间隔行

从下往上遍历（ Step -1 ）避免行号错位

直接通过区域操作（ rng.Rows ）确保处理位置准确

3. 统计准确性：

删除行数通过 deleteRng.Rows.Count 精确统计

保留行数 = 总行数 - 删除行数（自动包含标题行和第二行）

4. 健壮性增强：

增加工作表对象 ws 的显式声明

改进取消操作的友好提示

错误处理更完善

最后，给出了使用示例和注意事项：

区域选择：必须包含标题行（作为区域第一行）

数据格式：确保没有合并单元格，否则可能影响删除准确性

大型数据集：处理 10 万行数据仅需约 2 秒（原代码需约 20 秒）

还提示：如果需要处理动态区域，可进一步优化为自动检测数据范围。您是否需要这个功能的扩展实现？

我接着提问：

“ 我需要处理动态区域，请帮我扩展实现 ”

deepseek 给出的结果如下：

以下是针对动态区域处理的增强版 VBA 代码，支持自动识别数据范围并优化删除效率：

Sub DeleteAlternateRowsDynamic() Dim ws As Worksheet Dim dataRng As Range Dim deleteRng As Range Dim startRow As Long Dim lastRow As Long Dim lastCol As Long Dim totalRows As Long Dim deleteCount As Long Dim




    
 i As Long
 Set ws = ActiveSheet Application.ScreenUpdating = False
 ' 动态查找数据范围 On Error Resume Next With ws   ' 查找最后一个非空单元格   lastRow = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), _     SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row   lastCol = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), _     SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column End With
 ' 验证数据有效性 If lastRow < 2 Then   MsgBox "未发现有效数据区域", vbExclamation   Exit Sub End If
 Set dataRng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)) totalRows = dataRng.Rows.Count startRow = 3  ' 保留标题行(第1行)和第2行
 ' 集合操作删除行 For i = totalRows To startRow Step -1   If (i - startRow) Mod 2 = 0 Then     If deleteRng Is Nothing Then       Set deleteRng = dataRng.Rows(i)     Else       Set deleteRng = Union(deleteRng, dataRng.Rows(i))     End If   End If Next i
 ' 执行批量删除 If Not deleteRng Is Nothing Then   deleteRng.EntireRow.Delete   deleteCount = deleteRng.Rows.Count End If
 Application.ScreenUpdating = True
 ' 显示智能统计结果 MsgBox "数据区域: " & dataRng.Address & vbCrLf & _   "原始总行数: " & totalRows & vbCrLf & _   "删除行数: " & deleteCount & vbCrLf & _   "保留行数: " & totalRows - deleteCount, _   vbInformation, "动态删除完成"End Sub

新功能亮点说明：

1. 智能区域检测：

使用 Find 方法精准定位数据边界（支持非连续数据）

自动识别真实数据范围（即使存在空单元格或格式干扰）

lastRow = .Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).RowlastCol = .Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column

2. 性能优化：

集合操作效率比原代码提升约 40% （通过减少 Union 调用次数）

For i = totalRows To startRow Step -2 ' 直接间隔遍历 If deleteRng Is Nothing Then   Set deleteRng = dataRng.Rows(i) Else   Set deleteRng = Union(deleteRng, dataRng.Rows(i)) End IfNext i

3. 智能异常处理：

自动跳过隐藏行（不影响删除逻辑）

自动处理合并单元格（删除整行不影响结构）

If dataRng.Rows(i).Hidden = False Then ' 可选：跳过隐藏行 ' 删除逻辑End If

4. 动态统计报告：

显示实际处理的数据区域地址

精确统计包含 / 排除隐藏行的数量

MsgBox "数据区域: " & dataRng.Address & ...

扩展功能建议（可根据需要添加）：

' 可选功能：删除前创建备份If MsgBox("是否创建数据备份？", vbYesNo) = vbYes Then ws.Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = "备份_" & Format(Now, "yyyymmdd_hhmm")End If' 可选功能：保留特殊标记行（如黄色填充行）For i = totalRows To startRow Step -1 If dataRng.Rows(i).Interior.Color <> vbYellow Then ' 正常删除逻辑 End IfNext i' 可选功能：进度条显示Application.StatusBar = "正在处理行：" & i & " (" & Format(i/totalRows, "0%") & ")"

但是，运行后发觉，上面代码中的 deleteCount 值不正确，于是接着向 deepseek 提问：

“ 上面的代码中， deleteCount 的值不正确，应该进一步处理 ”

deepseek 很快查到了原因并对代码进行了修复：

感谢指出问题！ deleteCount 的值不正确是因为在 Union 操作后，直接使用 deleteRng.Rows.Count 统计行数时可能会忽略某些特殊情况（例如非连续区域）。我们需要在收集删除行时单独统计 deleteCount 的值。

以下是修正后的代码，确保 deleteCount 统计准确：

Sub DeleteAlternateRowsDynamic() Dim ws As Worksheet Dim dataRng As Range Dim deleteRng As Range Dim startRow As Long Dim lastRow As Long Dim lastCol As Long Dim totalRows As Long Dim deleteCount As Long Dim i As Long

使用deepseek优化VBA代码

正文

请到「今天看啥」查看全文