谷动谷力

标题: Excel中使用VBA进行数据匹配并复制相应行到另一个表 [打印本页]

---

作者: sunsili    时间: 2024-4-17 17:21
标题: Excel中使用VBA进行数据匹配并复制相应行到另一个表


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


题记

今天媳妇给我说：

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

源数据表有16184行。

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

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

工作步骤

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

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

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

代码嘛，先AI试试



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

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

1. 
   
2. Sub MatchAndCopyData()
   
3. 
   
4. ' 定义工作簿和工作表对象
   
5. 
   
6.     Dim wb As Workbook
   
7. 
   
8.     Set wb = ThisWorkbook ' 使用当前工作簿，或指定具体路径 Set wb = Workbooks.Open("D:\exlsx\file.xlsx")
   
9. 
   
10.    
    
11. 
    
12.     ' 定义表1、表2和表3工作表对象
    
13. 
    
14.     Dim wsSource As Worksheet, wsMatch As Worksheet, wsTarget As Worksheet
    
15. 
    
16.     Set wsSource = wb.Sheets("Sheet1") ' 表1的名称 源数据表
    
17. 
    
18.     Set wsMatch = wb.Sheets("Sheet2") ' 表2的名称  匹配数据表
    
19. 
    
20.     Set wsTarget = wb.Sheets("Sheet3") ' 表3的名称 目的数据表
    
21. 
    
22.    
    
23. 
    
24.     ' 初始化变量
    
25. 
    
26.     Dim iRowSrc As Long, iRowMatch As Long, iRowTgt As Long
    
27. 
    
28.     iRowSrc = 2 ' 表1数据起始行（假设第一行为表头）
    
29. 
    
30.     iRowMatch = 1 ' 表2数据起始行（假设无表头）
    
31. 
    
32.     iRowTgt = 2 ' 表3数据起始行（假设第一行为表头）
    
33. 
    
34.    
    
35. 
    
36.     ' 循环遍历表2数据
    
37. 
    
38.     While wsMatch.Cells(iRowMatch, 1).Value <> "" ' 假设以A列非空判断是否有数据
    
39. 
    
40.         
    
41. 
    
42.         ' 从表1查找匹配项
    
43. 
    
44.         Dim matchFound As Boolean: matchFound = False
    
45. 
    
46.         Dim matchRow As Long
    
47. 
    
48.         For iRowSrc = 2 To wsSource.Rows.Count ' 循环表1数据行
    
49. 
    
50.             If wsSource.Cells(iRowSrc, 2).Value = wsMatch.Cells(iRowMatch, 1).Value Then ' 假设以匹配数据A列匹配数据源表的B列
    
51. 
    
52.                 matchFound = True
    
53. 
    
54.                 matchRow = iRowSrc
    
55. 
    
56.                 ' 复制匹配到的表1数据行到表3               
    
57. 
    
58.                 wsSource.Rows(matchRow).Copy Destination:=wsTarget.Rows(iRowTgt)
    
59. 
    
60.                 iRowTgt = iRowTgt + 1 ' 更新目标表的下一行  
    
61. 
    
62.                 iRowMatch = iRowMatch + 1 ' 移动到表2的下一行
    
63. 
    
64.             End If
    
65. 
    
66.         Next iRowSrc      
    
67. 
    
68.         
    
69. 
    
70.     Wend   
    
71. 
    
72.     MsgBox "匹配并复制数据完成！"
    
73. 
    
74. End sub

复制代码

写完代码保存

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

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

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

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

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

运行：

运行结果

---

欢迎光临 谷动谷力 (http://bbs.sunsili.com/)

Powered by Discuz! X3.2