谷动谷力

 找回密码
 立即注册
查看: 11943|回复: 0
收起左侧

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

[复制链接]
发表于 2024-4-17 17:21:16 | 显示全部楼层 |阅读模式
本帖最后由 sunsili 于 2024-4-17 17:35 编辑

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


题记

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

excel

excel

excel

excel


源数据表有16184行。

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

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

工作步骤

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

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

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

代码嘛,先AI试试

AiCode

AiCode



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

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

  1. Sub MatchAndCopyData()

  2. ' 定义工作簿和工作表对象

  3.     Dim wb As Workbook

  4.     Set wb = ThisWorkbook ' 使用当前工作簿,或指定具体路径 Set wb = Workbooks.Open("D:\exlsx\file.xlsx")

  5.    

  6.     ' 定义表1、表2和表3工作表对象

  7.     Dim wsSource As Worksheet, wsMatch As Worksheet, wsTarget As Worksheet

  8.     Set wsSource = wb.Sheets("Sheet1") ' 表1的名称 源数据表

  9.     Set wsMatch = wb.Sheets("Sheet2") ' 表2的名称  匹配数据表

  10.     Set wsTarget = wb.Sheets("Sheet3") ' 表3的名称 目的数据表

  11.    

  12.     ' 初始化变量

  13.     Dim iRowSrc As Long, iRowMatch As Long, iRowTgt As Long

  14.     iRowSrc = 2 ' 表1数据起始行(假设第一行为表头)

  15.     iRowMatch = 1 ' 表2数据起始行(假设无表头)

  16.     iRowTgt = 2 ' 表3数据起始行(假设第一行为表头)

  17.    

  18.     ' 循环遍历表2数据

  19.     While wsMatch.Cells(iRowMatch, 1).Value <> "" ' 假设以A列非空判断是否有数据

  20.         

  21.         ' 从表1查找匹配项

  22.         Dim matchFound As Boolean: matchFound = False

  23.         Dim matchRow As Long

  24.         For iRowSrc = 2 To wsSource.Rows.Count ' 循环表1数据行

  25.             If wsSource.Cells(iRowSrc, 2).Value = wsMatch.Cells(iRowMatch, 1).Value Then ' 假设以匹配数据A列匹配数据源表的B列

  26.                 matchFound = True

  27.                 matchRow = iRowSrc

  28.                 ' 复制匹配到的表1数据行到表3               

  29.                 wsSource.Rows(matchRow).Copy Destination:=wsTarget.Rows(iRowTgt)

  30.                 iRowTgt = iRowTgt + 1 ' 更新目标表的下一行  

  31.                 iRowMatch = iRowMatch + 1 ' 移动到表2的下一行

  32.             End If

  33.         Next iRowSrc      

  34.         

  35.     Wend   

  36.     MsgBox "匹配并复制数据完成!"

  37. End sub
复制代码

VBA

VBA


写完代码保存

***
在使用此代码之前,请确保:

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

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

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

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

运行:

运行VBA

运行VBA

运行结果

excel

excel




+10
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|Archiver|手机版|深圳市光明谷科技有限公司|光明谷商城|Sunshine Silicon Corpporation ( 粤ICP备14060730号|Sitemap

GMT+8, 2024-6-23 08:39 , Processed in 0.074364 second(s), 40 queries .

Powered by Discuz! X3.2 Licensed

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表