Excel中使用VBA进行数据匹配并复制相应行到另一个表
本帖最后由 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。你可以根据实际需求调整代码中的工作表名称、数据范围和复制的列。
***
运行:
运行结果
页:
[1]