去评论
距米网-精简版

查找B列单元格内容，如果查到相同的单元格，只保留最后一行，其余行删除

JUMU
2026/02/07 19:46:38
这个VBA程序可以帮你实现这个需求。它会遍历B列，找出重复值，只保留最后一行：

  1. Sub 删除B列重复值并保留最后一行()
  2.     Dim ws As Worksheet
  3.     Dim lastRow As Long
  4.     Dim rng As Range
  5.     Dim cell As Range
  6.     Dim dict As Object
  7.     Dim key As String
  8.     Dim i As Long

  10.     ' 设置当前工作表
  11.     Set ws = ActiveSheet

  13.     ' 获取B列最后一行
  14.     lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

  16.     ' 创建字典用于存储每个值的最后出现行号
  17.     Set dict = CreateObject("Scripting.Dictionary")

  19.     ' 从下往上遍历B列，记录每个值的最后出现行号
  20.     For i = lastRow To 1 Step -1
  21.         key = CStr(ws.Cells(i, "B").Value)
  22.         If key <> "" Then ' 跳过空单元格
  23.             If Not dict.exists(key) Then
  24.                 dict.Add key, i ' 只记录第一次遇到的值（从下往上就是最后一行）
  25.             End If
  26.         End If
  27.     Next i

  29.     ' 再次遍历B列，删除不在字典中的行
  30.     Application.ScreenUpdating = False
  31.     Application.Calculation = xlCalculationManual

  33.     For i = lastRow To 1 Step -1
  34.         key = CStr(ws.Cells(i, "B").Value)
  35.         If key <> "" Then
  36.             If dict.exists(key) Then
  37.                 If dict(key) <> i Then ' 如果不是最后一行
  38.                     ws.Rows(i).Delete
  39.                 End If
  40.             End If
  41.         End If
  42.     Next i

  44.     ' 恢复屏幕更新和计算
  45.     Application.ScreenUpdating = True
  46.     Application.Calculation = xlCalculationAutomatic

  48.     MsgBox "已完成！B列重复值已删除，仅保留最后一行。", vbInformation
  49. End Sub


**使用方法：**

1 打开Excel文件
2 按 `Alt + F11` 打开VBA编辑器
3 点击 `插入` → `模块`
4 将上面的代码粘贴到模块中
5 按 `F5` 运行程序

**功能说明：**

- 程序会自动处理当前活动工作表
- 从B列底部开始向上遍历，记录每个值的最后出现位置
- 然后删除所有不是最后出现位置的重复行
- 空单元格会被跳过
- 操作过程中会关闭屏幕更新以提高效率

**注意事项：**

- 建议在运行前先备份数据
- 如果数据量很大，可能需要一些时间来完成
- 程序会删除整行，包括该行其他列的数据

进入原文