Excel通过VBA脚本去除重复数据行并保存

一、方法1:使用字典动态去重并保存

适用场景：需要灵活控制去重逻辑（如保留最后一次出现的重复项）时

Sub 动态去重保存到新表()
    Dim srcSheet As Worksheet, destSheet As Worksheet
    Dim dict As Object, lastRow As Long, i As Long
    Dim key As Variant  ' ? 声明为Variant
    Set dict = CreateObject("Scripting.Dictionary")
    Set srcSheet = ThisWorkbook.Sheets("Sheet1")  ' 替换为源表名称
    Set destSheet = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
    
    ' 读取数据并去重（假设数据从第2行开始）
    lastRow = srcSheet.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        Dim combinedKey As String
        combinedKey = srcSheet.Cells(i, 1).Value & "|" & srcSheet.Cells(i, 2).Value
        dict(combinedKey) = i  ' 记录最后一次出现的行号
    Next i
    
    ' 将去重后的数据写入新表
    destSheet.Range("A1:B1").Value = Array("产品", "二进制编码")  ' 标题行
    Dim rowIndex As Long: rowIndex = 2
    For Each key In dict.Keys  ' ? key已声明为Variant
        Dim originalRow As Long: originalRow = dict(key)
        destSheet.Cells(rowIndex, 1).Value = srcSheet.Cells(originalRow, 1).Value
        destSheet.Cells(rowIndex, 2).Value = srcSheet.Cells(originalRow, 2).Value
        rowIndex = rowIndex + 1
    Next key
    MsgBox "数据已保存到新表：" & destSheet.Name
End Sub

可能的错误点：提示for each控件变量必须为变体或对象

1. 遍历字典Keys时，循环变量声明为String而非Variant。
2. 遍历工作表或区域时，循环变量声明不正确。
3. 在处理对象集合时未使用正确的对象类型声明变量。

关键点总结

1. 变量声明匹配集合类型

   • 遍历对象集合（如工作表、单元格）时，用 Object 或具体对象类型（如 Worksheet）。
   • 遍历字典键、数组等非对象集合时，用 Variant。

2. 避免隐式类型声明 永远不要省略变量类型声明（如直接写 Dim key），这会导致VBA默认使用 Variant，但显式声明更安全。

3. 字典的特殊性 Scripting.Dictionary 的 Keys 和 Items 返回的是 Variant 数组，必须用 Variant 类型接收。

二、方法二**：复制筛选数据到新表后去重**

适用场景：先筛选数据再复制到新工作表，最后在新表中去重。

Sub 筛选去重保存到新表()
    Dim srcSheet As Worksheet, destSheet As Worksheet
    Set srcSheet = ThisWorkbook.Sheets("原始数据")  ' 替换为源表名称
    Set destSheet = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))  ' 创建新工作表
    
    ' 应用筛选（假设筛选第3列值为"完成"）
    srcSheet.Range("A1:D100").AutoFilter Field:=3, Criteria1:="完成"
    
    ' 复制可见单元格到新表
    srcSheet.AutoFilter.Range.Copy
    destSheet.Range("A1").PasteSpecial xlPasteValues
    
    ' 在新表中去重（假设按第1列和第2列组合去重）
    destSheet.Range("A1:D" & destSheet.Cells(Rows.Count, 1).End(xlUp).Row).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    
    ' 清除筛选状态
    srcSheet.AutoFilterMode = False
    Application.CutCopyMode = False
    MsgBox "数据已保存到新表：" & destSheet.Name
End Sub

如果不需要筛选?

Sub 筛选去重保存到新表()
    Dim srcSheet As Worksheet, destSheet As Worksheet
    Dim srcDataRange As Range, lastRow As Long
    
    ' 设置源表和目标表
    Set srcSheet = ThisWorkbook.Sheets("Sheet1")  ' 替换为你的源表名称
    Set destSheet = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))  ' 创建新表
    
    ' 动态获取源表数据范围（假设数据从A1开始，列数为4列：A-D）
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row
    Set srcDataRange = srcSheet.Range("A1:D" & lastRow)  ' A-D列
    
    ' 直接复制全部数据到新表（无需筛选）
    srcDataRange.Copy
    destSheet.Range("A1").PasteSpecial xlPasteValues
    
    ' 在新表中按第1、2列去重
    Dim destLastRow As Long
    destLastRow = destSheet.Cells(destSheet.Rows.Count, 1).End(xlUp).Row
    If destLastRow > 1 Then
        destSheet.Range("A1:D" & destLastRow).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    Else
        MsgBox "警告：未复制到有效数据！"
    End If
    
    ' 清理剪贴板并提示完成
    Application.CutCopyMode = False
    MsgBox "数据已保存到新表：" & destSheet.Name
End Sub

参数逐条解析

1. Range("A1:D100")

   • 表示要筛选的数据区域（从A1到D100的矩形范围）。

2. AutoFilter 方法

   • Excel VBA 中用于启用自动筛选的方法，类似于手动点击Excel菜单的 "数据" → "筛选"。

3. Field:=3

   • 指定筛选的列号。
   • 这里的 Field 参数代表第几列（从数据区域的左起第1列开始计数）。
   • 例如，A1:D100 区域的第1列是A列，第3列是C列。

4. Criteria1:="完成"

   • 设置筛选条件为"等于'完成'"。
   • Criteria1 是筛选条件的关键字，支持通配符（如 "*完成*" 表示包含"完成"的文本）。