示例成品 · 平台演示,按左边这组点选真跑出来的
直接把这个 VBA 跑起来就行。它不要求你手动对齐列,会按表头自动找“交易时间、金额、对方账号”这三列,按这 3 个字段判重;重复的只保留一条,并把来源账户标出来,空缺字段能补就补。
先把效果说清楚:
- 判重键:**交易时间到分钟 + 金额带正负 + 对方账号去空格/半角**
- 重复保留:**首次记录为底,后续重复行补充空缺字段,来源合并**
- 会生成 3 张表:`合并对账结果`、`重复明细`、`对账汇总`
---
## 使用前提
1. 把 2-3 个账户流水放在**同一个工作簿**的不同工作表里。
2. 每个流水表**第一行是标题**。
3. 工作表名最好改成账户名,比如 `基本户`、`一般户`,这样来源标记才清楚。
4. 对方账号列如果已经被 Excel 显示成科学计数、末尾变 000,代码救不回来。先把该列设成“文本”再重新粘贴一次。
---
## 操作步骤
1. 打开 Excel 文件。
2. 按 `Alt + F11` 打开 VBA 编辑器。
3. 左侧右键 `VBAProject` → `插入` → `模块`。
4. 把下面代码整段粘贴进去。
5. 光标放在代码里,按 `F5` 运行。
---
## 代码
```vba
Option Explicit
Sub 多账户银行流水合并去重()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim dupLog As Collection
Set dupLog = New Collection
Dim mergedSheets As String
Dim skippedSheets As String
Dim totalRows As Long
totalRows = 0
Dim wsOut As Worksheet, wsDup As Worksheet, wsSum As Worksheet
Dim ws As Worksheet
Dim headers As Variant
Dim lastCol As Long
Dim c As Long
Dim colTime As Long, colAmt As Long, colAmtIn As Long, colAmtOut As Long, colAccount As Long
Dim colPName As Long, colSummary As Long, colDir As Long
Dim amtMode As String
Dim lastRow As Long
Dim r As Long
Dim timeRaw As Variant, amtRaw As Variant, acctRaw As Variant
Dim pnameRaw As Variant, summaryRaw As Variant, dirRaw As Variant
Dim timeNorm As String
Dim amtVal As Double
Dim inVal As Double, outVal As Double
Dim hasAmt As Boolean
Dim acctNorm As String
Dim amtKey As String
Dim key As String
Dim rec As Object
Dim filled As String
Dim recNew As Object
Dim outRow As Long
Dim k As Variant
Dim arr As Variant
Dim dupRow As Long
Dim it As Variant
Dim income As Double, expense As Double, dedupRows As Long
Dim summarySheet As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' 删除旧输出表
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "合并对账结果" Or ws.Name = "重复明细" Or ws.Name = "对账汇总" Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True
' 新建输出表
Set wsOut = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wsOut.Name = "合并对账结果"
Set wsDup = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wsDup.Name = "重复明细"
Set wsSum = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wsSum.Name = "对账汇总"
' 输出表标题
wsOut.Range("A1:L1").Value = Array( _
"交易时间(规范)", "交易时间原始", "金额", "对方账号", "对方户名", _
"摘要", "收支方向", "来源账户", "来源工作表", "首次来源行", "重复次数", "补充字段")
wsDup.Range("A1:H1").Value = Array( _
"判重键", "交易时间", "金额", "对方账号", "当前来源表", "当前行", "保留记录来源", "首次来源行")
' 遍历所有工作表
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "合并对账结果" And ws.Name <> "重复明细" And ws.Name <> "对账汇总" Then
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
If lastCol < 1 Then lastCol = 1
ReDim headers(1 To lastCol)
For c = 1 To lastCol
headers(c) = Trim(CStr(ws.Cells(1, c).Value))
Next c
' 找关键列
colTime = FindCol(headers, Array( _
"交易时间", "交易日期时间", "入账时间", "记账时间", "发生时间", _
"交易日期", "入账日期", "发生日期", "日期时间", "时间", "日期"))
colAccount = FindCol(headers, Array( _
"对方账号", "对方帐号", "对手方账号", "对手
点左边「开工 · 直接出成品」,出一份你自己的版本(文字免费)