Excel VBA需求：比对工作表账号并插入新增账号至指定表

需求说明 #

• 比对「Balances」和「Todays Bals」两张工作表的账号列表
• 筛选出「Todays Bals」中未在「Balances」出现的新增账号
• 在「Balances」表的账号列表末尾插入与新增账号数量一致的空行
• 将筛选出的新增账号复制到「Balances」的插入行A列

完整VBA代码 #

Dim wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim LastRow1 As Long, LastRow2 As Long
Dim Rng As Range, newAccountsRng As Range
Dim addCount As Long

Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Todays Bals")
Set ws2 = wb.Worksheets("Balances")

' 复制Todays Bals工作表用于筛选新增账号
ws1.Copy after:=ws2
Set ws3 = wb.ActiveSheet

With ws3
    LastRow1 = .Cells(Rows.Count, 1).End(xlUp).Row
    ' 添加VLOOKUP公式匹配Balances中的账号
    .Range("D1").Value = "Vlookup"
    .Range("D2").Value = "=VLOOKUP(B2," & ws2.Name & "!A:A,1,0)"
    .Range("D2").Copy .Range("D3:D" & LastRow1)
    ' 筛选出匹配结果为#N/A的新增账号
    .Range("A1:D1").AutoFilter Field:=4, Criteria1:="#N/A"
    
    ' 获取筛选后的新增账号区域（B列，排除表头）
    On Error Resume Next ' 处理无新增账号的情况
    Set newAccountsRng = .Range("B2:B" & LastRow1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not newAccountsRng Is Nothing Then
        addCount = newAccountsRng.Cells.Count
        ' 获取Balances表的最后一行
        LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
        ' 在Balances末尾插入对应数量的行
        ws2.Rows(LastRow2 + 1 & ":" & LastRow2 + addCount).Insert Shift:=xlDown
        ' 将新增账号复制到Balances的A列插入行
        newAccountsRng.Copy ws2.Range("A" & LastRow2 + 1)
    End If
    
    ' 删除临时筛选用的工作表
    Application.DisplayAlerts = False
    ws3.Delete
    Application.DisplayAlerts = True
End With

End Sub

关键补充说明 #

• 新增账号区域获取：使用SpecialCells(xlCellTypeVisible)提取筛选后的新增账号，同时加入错误处理避免无新增账号时报错
• 插入行逻辑：先获取「Balances」表的最后一行，再根据新增账号数量批量插入空行
• 账号复制：直接将筛选出的账号区域复制到「Balances」的插入行起始位置
• 临时表清理：完成操作后自动删除用于筛选的临时工作表，避免冗余

内容的提问来源于stack exchange，提问作者Adezzz