我想开个网站360收录查询
Excel VBA实现智能合并重复元器件数据（型号去重+数量累加）
关键词：Excel自动化、VBA数据处理、重复项合并、元器件管理
功能概述
本工具针对电子元器件库存表/采购清单等场景，实现：
- 按型号列自动识别重复元器件
- 智能合并重复项并累加数量
- 保留首次出现记录，删除后续重复行
- 支持万级数据量快速处理
应用场景
- 电子元器件库存合并
- BOM表重复项清理
- 采购订单数据整合
- 实验室耗材统计
实现原理
核心算法流程图
完整代码
Sub MergeDuplicateComponents()On Error Resume Next ' 基础错误处理'【参数配置区】可根据需求修改Const TYPE_COL As Integer = 3 ' 型号所在列（C列）Const QTY_COL As Integer = 6 ' 数量所在列（F列）Const START_ROW As Integer = 2 ' 数据起始行Dim ws As WorksheetDim lastRow As Long, i As Long, j As LongDim currentType As String, currentQty As LongSet ws = ActiveSheetlastRow = ws.Cells(ws.Rows.Count, TYPE_COL).End(xlUp).RowApplication.ScreenUpdating = FalseApplication.Calculation = xlCalculationManual' 从第二行开始向上处理i = START_ROWDo While i <= lastRowcurrentType = ws.Cells(i, TYPE_COL).ValuecurrentQty = ws.Cells(i, QTY_COL).Value' 从最后一行向下检查For j = lastRow To i + 1 Step -1If ws.Cells(j, TYPE_COL).Value = currentType ThencurrentQty = currentQty + ws.Cells(j, QTY_COL).Valuews.Rows(j).DeletelastRow = lastRow - 1End IfNext j' 更新当前行的数量ws.Cells(i, QTY_COL).Value = currentQtyi = i + 1LoopApplication.ScreenUpdating = TrueApplication.Calculation = xlCalculationAutomaticMsgBox "处理完成！共合并" & lastRow - START_ROW + 1 & "条有效记录", vbInformation
End Sub
代码说明：
-
初始化设置：获取活动工作表并确定数据最后一行
-
从第二行开始逐行处理（i循环）
-
对每个元器件类型，从最后一行向前检查重复项（j循环）
-
发现重复时累加数量并删除重复行
-
更新当前行的汇总数量
-
使用双循环结构确保完整遍历所有数据
-
添加了屏幕更新和计算控制以优化性能
使用方法：
-
按Alt+F11打开VBA编辑器
-
插入新模块并粘贴代码
-
返回Excel运行宏"MergeDuplicateComponents"
-
确保数据格式符合要求（第3列为型号，第6列为数量）
注意事项：
-
数据必须从第2行开始
-
第一行会被自动识别为标题行
-
合并后保留最上方出现的记录
-
原始数据建议先备份
代码主要实现以下功能
-
智能行号跟踪
-
倒序删除避免遗漏
-
数量自动累加
-
高效数据处理机制
执行效果
- 所有相同型号的记录会被合并到第一个出现的位置，数量自动求和，后续重复行自动删除。
处理前如图
处理后如图
可以看出，22R和1k的电阻进行了合并，且数量进行了相加。
**如果觉得这个解决方案有帮助，欢迎点赞❤️收藏⭐️关注✅！如果有其他Excel难题，欢迎在评论区留言交流~