一、方法1:使用字典动态去重并保存
适用场景:需要灵活控制去重逻辑(如保留最后一次出现的重复项)时
Sub 动态去重保存到新表()Dim srcSheet As Worksheet, destSheet As WorksheetDim dict As Object, lastRow As Long, i As LongDim key As Variant ' ? 声明为VariantSet 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).RowFor i = 2 To lastRowDim combinedKey As StringcombinedKey = srcSheet.Cells(i, 1).Value & "|" & srcSheet.Cells(i, 2).Valuedict(combinedKey) = i ' 记录最后一次出现的行号Next i' 将去重后的数据写入新表destSheet.Range("A1:B1").Value = Array("产品", "二进制编码") ' 标题行Dim rowIndex As Long: rowIndex = 2For Each key In dict.Keys ' ? key已声明为VariantDim originalRow As Long: originalRow = dict(key)destSheet.Cells(rowIndex, 1).Value = srcSheet.Cells(originalRow, 1).ValuedestSheet.Cells(rowIndex, 2).Value = srcSheet.Cells(originalRow, 2).ValuerowIndex = rowIndex + 1Next keyMsgBox "数据已保存到新表:" & destSheet.Name
End Sub
可能的错误点:提示for each控件变量必须为变体或对象
- 遍历字典Keys时,循环变量声明为String而非Variant。
- 遍历工作表或区域时,循环变量声明不正确。
- 在处理对象集合时未使用正确的对象类型声明变量。
关键点总结
-
变量声明匹配集合类型
- 遍历对象集合(如工作表、单元格)时,用
Object
或具体对象类型(如Worksheet
)。 - 遍历字典键、数组等非对象集合时,用
Variant
。
- 遍历对象集合(如工作表、单元格)时,用
-
避免隐式类型声明 永远不要省略变量类型声明(如直接写
Dim key
),这会导致VBA默认使用Variant
,但显式声明更安全。 -
字典的特殊性
Scripting.Dictionary
的Keys
和Items
返回的是Variant
数组,必须用Variant
类型接收。
二、方法二:复制筛选数据到新表后去重
适用场景:先筛选数据再复制到新工作表,最后在新表中去重。
Sub 筛选去重保存到新表()Dim srcSheet As Worksheet, destSheet As WorksheetSet srcSheet = ThisWorkbook.Sheets("原始数据") ' 替换为源表名称Set destSheet = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)) ' 创建新工作表' 应用筛选(假设筛选第3列值为"完成")srcSheet.Range("A1:D100").AutoFilter Field:=3, Criteria1:="完成"' 复制可见单元格到新表srcSheet.AutoFilter.Range.CopydestSheet.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 = FalseApplication.CutCopyMode = FalseMsgBox "数据已保存到新表:" & destSheet.Name
End Sub
如果不需要筛选?
Sub 筛选去重保存到新表()Dim srcSheet As Worksheet, destSheet As WorksheetDim 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).RowSet srcDataRange = srcSheet.Range("A1:D" & lastRow) ' A-D列' 直接复制全部数据到新表(无需筛选)srcDataRange.CopydestSheet.Range("A1").PasteSpecial xlPasteValues' 在新表中按第1、2列去重Dim destLastRow As LongdestLastRow = destSheet.Cells(destSheet.Rows.Count, 1).End(xlUp).RowIf destLastRow > 1 ThendestSheet.Range("A1:D" & destLastRow).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYesElseMsgBox "警告:未复制到有效数据!"End If' 清理剪贴板并提示完成Application.CutCopyMode = FalseMsgBox "数据已保存到新表:" & destSheet.Name
End Sub
参数逐条解析
-
Range("A1:D100")
- 表示要筛选的数据区域(从A1到D100的矩形范围)。
-
AutoFilter
方法- Excel VBA 中用于启用自动筛选的方法,类似于手动点击Excel菜单的 “数据” → “筛选”。
-
Field:=3
- 指定筛选的列号。
- 这里的
Field
参数代表第几列(从数据区域的左起第1列开始计数)。 - 例如,
A1:D100
区域的第1列是A列,第3列是C列。
-
Criteria1:="完成"
- 设置筛选条件为“等于‘完成’”。
Criteria1
是筛选条件的关键字,支持通配符(如"*完成*"
表示包含“完成”的文本)。