如何用Excel VBA按Table1的Name列筛选复制Table2指定列至Table3

实现逻辑 #

• 读取Worksheet1中Table1单行的Name列值
• 若Name为空，将筛选目标设为"Default"；否则使用读取到的Name值
• 在Worksheet2的Table2中匹配对应行，复制指定列数据到Worksheet1的Table3

完整代码 #

Sub CopyFilteredTableData()
    Dim wsTarget As Worksheet, wsSource As Worksheet
    Dim tblCriteria As ListObject, tblData As ListObject, tblResult As ListObject
    Dim filterName As String
    Dim matchRow As ListRow
    Dim colsToCopy As Variant
    Dim colName As String
    Dim resultCol As ListColumn
    
    ' 配置要复制的列名，按需修改
    colsToCopy = Array("列A", "列B", "列C")
    
    ' 绑定工作表与表格对象，确保名称与实际文件一致
    Set wsTarget = ThisWorkbook.Worksheets("Worksheet1")
    Set wsSource = ThisWorkbook.Worksheets("Worksheet2")
    Set tblCriteria = wsTarget.ListObjects("Table1")
    Set tblData = wsSource.ListObjects("Table2")
    Set tblResult = wsTarget.ListObjects("Table3")
    
    ' 获取筛选条件（Table1为单行，直接取第一行Name列值）
    filterName = tblCriteria.ListColumns("Name").DataBodyRange(1).Value
    
    ' 确定最终筛选名称
    If Trim(filterName) = vbNullString Then
        filterName = "Default"
    End If
    
    ' 清空结果表现有数据（可选，若需保留历史数据可删除此段）
    If tblResult.ListRows.Count > 0 Then
        tblResult.DataBodyRange.Delete
    End If
    
    ' 遍历Table2查找匹配行
    For Each matchRow In tblData.ListRows
        If matchRow.Range(tblData.ListColumns("Name").Index).Value = filterName Then
            ' 在Table3新增行
            Dim newResultRow As ListRow
            Set newResultRow = tblResult.ListRows.Add
            
            ' 复制指定列数据
            For Each colName In colsToCopy
                On Error Resume Next ' 忽略列名不存在的错误
                Set resultCol = tblResult.ListColumns(colName)
                If Not resultCol Is Nothing Then
                    newResultRow.Range(resultCol.Index).Value = matchRow.Range(tblData.ListColumns(colName).Index).Value
                End If
                On Error GoTo 0
            Next colName
            
            Exit For ' 仅复制第一匹配行，若需复制所有匹配行则删除此句
        End If
    Next matchRow
End Sub

关键说明 #

• colsToCopy数组：替换成你实际需要复制的列名称，确保Table2和Table3中都存在这些列
• 对象绑定：确认代码中的工作表、表格名称与你的Excel文件完全一致
• 清空结果表：如果不需要清除Table3原有数据，删除清空数据的代码块即可
• 多匹配行处理：若Table2中存在多个符合筛选条件的行，删除Exit For语句就能复制所有匹配行

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