VBA实现动态工作表数据去重后条件追加至静态工作表

需求说明 #

现有动态更新的Data工作表，项目所有者可随时变更。需实现点击按钮时，将所有者为Sam的项目追加至静态Project工作表，要求：

• 仅导入项目单元格（而非整行，防止手动录入列错位）
• 避免重复追加相同项目

示例数据 #

源数据（Data工作表） #

期望结果（Project工作表） #

调试中的VBA代码 #

Private Sub CommandButton1_Click()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim ws1LR As Long, ws2LR As Long
    Dim i As Long, j As Long
    Dim ws1rng As Range, ws2rng As Range
    Dim ID, ws2sr, Project
    
    'Set the search ID (Sam)
    Set ID = Range("P2")
    
    'Set project sheet range
    Set ws1 = Sheets("Project")
    ws1LR = ws1.Range("A" & Rows.Count).End(xlUp).Row
    Set ws1rng = ws1.Range("A1:A" & ws1LR)
    
    'Set data set range
    Set ws2 = Sheets("Data")
    ws2LR = ws2.Range("A" & Rows.Count).End(xlUp).Row
    Set ws2rng = ws1.Range("A1:A" & ws2LR)
    
    'loop through data set to find projects with Sam as owner
    For i = 1 To ws2LR
        'Search if cell contains Sam as owner in data
        ws2sr = ws2.Range("E" & i)
        If ws2sr = ID Then
            'call project value
            Project = ws2.Range("E" & i).Offset(0, -3)

            'If project is already in the new worksheet
                'Append project to new sheet
                'Range("A" & ws1rng + 1) = Project
            'Else
                       
        Else
        End If
    Next i
End Sub

修正后的可行VBA代码 #

Private Sub CommandButton1_Click()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRowSource As Long, lastRowTarget As Long
    Dim i As Long
    Dim targetID As String
    Dim projectName As String
    Dim isDuplicate As Variant
    
    ' 定义源/目标工作表对象
    Set wsSource = ThisWorkbook.Sheets("Data")
    Set wsTarget = ThisWorkbook.Sheets("Project")
    
    ' 获取目标所有者（Sam），指定工作表避免活动表切换错误
    targetID = ThisWorkbook.ActiveSheet.Range("P2").Value
    
    ' 获取源数据最后一行
    lastRowSource = wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row
    
    ' 遍历源数据（从第2行开始，跳过表头）
    For i = 2 To lastRowSource
        ' 检查当前行所有者是否匹配目标ID
        If wsSource.Range("E" & i).Value = targetID Then
            projectName = wsSource.Range("A" & i).Value ' 直接引用Project列，替代Offset避免列结构变动问题
            
            ' 检查项目是否已存在于目标表
            isDuplicate = Application.Match(projectName, wsTarget.Range("A:A"), 0)
            
            ' 不存在则追加至目标表末尾
            If IsError(isDuplicate) Then
                lastRowTarget = wsTarget.Range("A" & wsTarget.Rows.Count).End(xlUp).Row
                wsTarget.Range("A" & lastRowTarget + 1).Value = projectName
            End If
        End If
    Next i
End Sub

关键修正说明 #

1. 变量类型修正：将ID改为字符串类型，避免对象赋值错误
2. 重复检查优化：用Application.Match快速判断项目是否已存在，效率高于循环遍历
3. 列引用稳定性：直接引用Project所在的A列，替代Offset(0,-3)，避免后续列结构变动导致错误
4. 表头规避：遍历从第2行开始，跳过源数据表头行
5. 明确工作表引用：所有单元格操作都指定所属工作表，避免活动表切换导致的逻辑错误

内容的提问来源于stack exchange，提问作者Sam H.