请求协助实现带去重验证的VBA CountIf统计并弹窗显示结果

没问题，我来帮你调整代码实现需求！你的核心目标是：将源数据复制到新工作簿后，按Record locator列去除重复项（保留唯一值），再统计这些去重后的数据中XD的数量，最后用弹窗展示结果。

现有代码的几个问题 #

• 依赖Workbooks(2)、Workbooks(3)这类索引定位工作簿，一旦打开文件的顺序变化就会出错，稳定性差
• 大量使用Activate、Select操作，VBA中这类操作不仅效率低，还容易因界面交互触发意外错误
• 当前的CountIf是统计整个第9列的XD总数，没有结合去重逻辑，不符合需求

优化后的完整代码 #

Sub ProcessDataAndCountXD()
    Dim sourceWB As Workbook
    Dim targetWB As Workbook
    Dim sourceWS As Worksheet
    Dim targetWS As Worksheet
    Dim lastRow As Long
    Dim xdCount As Long
    
    ' 1. 打开源工作簿并引用对象
    Set sourceWB = Workbooks.Open("C:\Users\kjayachandiran\Desktop\ACUITY CF 1204-1210.xls")
    Set sourceWS = sourceWB.Worksheets(2) ' 源数据所在工作表
    
    ' 2. 打开目标工作簿并引用对象
    Set targetWB = Workbooks.Open("C:\Users\kjayachandiran\Desktop\New-Manjunath.xlsx")
    Set targetWS = targetWB.Worksheets(1) ' 目标工作表
    
    ' 3. 复制源数据到目标工作表（避免Select/Activate）
    sourceWS.UsedRange.Copy Destination:=targetWS.Range("A1")
    
    ' 4. 按Record locator列去除重复项
    ' 注意：请将Columns(XX)中的XX替换为Record locator所在的实际列号（比如第3列就写Columns(3)）
    targetWS.UsedRange.RemoveDuplicates Columns:=Array(XX), Header:=xlYes ' 如果没有表头就改成xlNo
    
    ' 5. 统计去重后数据中XD的数量（假设XD在第9列，即Columns(9)）
    lastRow = targetWS.Cells(targetWS.Rows.Count, 9).End(xlUp).Row ' 获取第9列最后一行数据行号
    xdCount = Application.WorksheetFunction.CountIf(targetWS.Range("I1:I" & lastRow), "XD")
    
    ' 6. 用MsgBox展示统计结果
    MsgBox "去重后Record locator唯一的行中，XD的数量为：" & xdCount, vbInformation, "统计结果"
    
    ' 7. 保存目标工作簿，关闭源工作簿
    targetWB.Save
    sourceWB.Close SaveChanges:=False ' 源工作簿如果不需要修改就设为False
    
    ' 释放对象变量
    Set sourceWS = Nothing
    Set sourceWB = Nothing
    Set targetWS = Nothing
    Set targetWB = Nothing
End Sub

关键说明 #

• 对象引用：用变量保存工作簿和工作表对象，避免索引出错，代码更易维护
• 去重逻辑：RemoveDuplicates方法直接对目标数据操作，需要你根据实际情况修改Columns(XX)中的列号（比如Record locator在第5列就写Array(5)），同时确认表头存在与否调整Header参数
• 统计逻辑：先获取去重后第9列的最后一行，再用CountIf统计该范围内的XD数量，确保只统计去重后的数据
• 避免Select/Activate：直接操作对象，代码运行更高效稳定

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