Excel中使用VBA进行数据匹配并复制相应行到另一个表

sunsili · 发表于 2024-4-17 17:21:16

本帖最后由 sunsili 于 2024-4-17 17:35 编辑

Excel中使用VBA进行数据匹配并复制相应行到另一个表

题记

今天媳妇给我说：

我要在第一张表里面要同时要找出这个十个货号来。不要一个个筛选，有没有一次性，就是我直接复制这十个货号，我就直接把十个货号里面的所有的资料

源数据表有16184行。

ctrl+f 一条一条复制，肯定不是我们程序员的风格了, 下一次再让我干这活呢（别人让我干这活，我肯定不干的，媳妇嘛，你懂的）。

原想vlookup函数，试了一下，再想想是不能用简单函数解决了。要写VBA代码宏。

工作步骤

在Excel中使用VBA进行数据匹配并复制相应行到另一个表的基本步骤如下：

打开Excel工作簿，并确保表1、表2和表3在不同的工作表上。

按下 ALT + F11 打开VBA编辑器。

代码嘛，先AI试试

复制AI生成的代码到VBA代码编辑器。

AI写的代码还是手动调整的，数据匹配不上，还有一个问题落数据（别问我是怎么知道的，试了就知道了，都说AI会替代程序员，看来还是不能没有我们程序员）。以下是我手动调整的代码：

Sub MatchAndCopyData()
' 定义工作簿和工作表对象
Dim wb As Workbook
Set wb = ThisWorkbook ' 使用当前工作簿，或指定具体路径 Set wb = Workbooks.Open("D:\exlsx\file.xlsx")
' 定义表1、表2和表3工作表对象
Dim wsSource As Worksheet, wsMatch As Worksheet, wsTarget As Worksheet
Set wsSource = wb.Sheets("Sheet1") ' 表1的名称源数据表
Set wsMatch = wb.Sheets("Sheet2") ' 表2的名称匹配数据表
Set wsTarget = wb.Sheets("Sheet3") ' 表3的名称目的数据表
' 初始化变量
Dim iRowSrc As Long, iRowMatch As Long, iRowTgt As Long
iRowSrc = 2 ' 表1数据起始行（假设第一行为表头）
iRowMatch = 1 ' 表2数据起始行（假设无表头）
iRowTgt = 2 ' 表3数据起始行（假设第一行为表头）
' 循环遍历表2数据
While wsMatch.Cells(iRowMatch, 1).Value <> "" ' 假设以A列非空判断是否有数据
' 从表1查找匹配项
Dim matchFound As Boolean: matchFound = False
Dim matchRow As Long
For iRowSrc = 2 To wsSource.Rows.Count ' 循环表1数据行
If wsSource.Cells(iRowSrc, 2).Value = wsMatch.Cells(iRowMatch, 1).Value Then ' 假设以匹配数据A列匹配数据源表的B列
matchFound = True
matchRow = iRowSrc
' 复制匹配到的表1数据行到表3
wsSource.Rows(matchRow).Copy Destination:=wsTarget.Rows(iRowTgt)
iRowTgt = iRowTgt + 1 ' 更新目标表的下一行
iRowMatch = iRowMatch + 1 ' 移动到表2的下一行
End If
Next iRowSrc
Wend
MsgBox "匹配并复制数据完成！"
End sub

复制代码

写完代码保存

***
在使用此代码之前，请确保：

工作表名称与代码中的名称相匹配。

表1、表2和表3的数据范围与代码中的假设相符（例如，都是从A2开始，并且都有列A作为匹配依据）。

如果表1或表2有标题行，请确保在代码中的范围中正确地表示出来（例如，"A2:C2" 而不是 "A1:C1"）。

运行此宏将会把表2中匹配到的行从表1复制到表3。你可以根据实际需求调整代码中的工作表名称、数据范围和复制的列。
***

运行：

运行结果

		自动登录	找回密码
密码			立即注册

Excel中使用VBA进行数据匹配并复制相应行到另一个表

相关帖子

浏览过的版块