帮我写一个VBA的代码,要求如下:筛选两个Excel表中的相同姓名,将两个表中相同姓名的信息整合到一个新表中
时间: 2023-11-22 16:53:47 浏览: 149
好的,以下是一个简单的VBA代码,可以实现你的需求:
```
Sub MergeTables()
Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim lastrow1 As Long, lastrow2 As Long, lastrow3 As Long
Dim i As Long, j As Long, k As Long
Dim name1 As String, name2 As String
'打开第一个工作簿
Set wb1 = Workbooks.Open("文件路径1")
Set ws1 = wb1.Sheets("Sheet1")
lastrow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row '获取第一个表格中的最后一行
'打开第二个工作簿
Set wb2 = Workbooks.Open("文件路径2")
Set ws2 = wb2.Sheets("Sheet1")
lastrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row '获取第二个表格中的最后一行
'创建新的工作簿
Set wb3 = Workbooks.Add
Set ws3 = wb3.Sheets("Sheet1")
'将表头复制到新表格中
ws1.Rows(1).Copy Destination:=ws3.Rows(1)
'遍历第一个表格中的每一行
For i = 2 To lastrow1
name1 = ws1.Cells(i, 1).Value '获取第一个表格中的姓名
'遍历第二个表格中的每一行
For j = 2 To lastrow2
name2 = ws2.Cells(j, 1).Value '获取第二个表格中的姓名
'如果两个姓名相同,则将信息复制到新表格中
If name1 = name2 Then
lastrow3 = ws3.Cells(Rows.Count, "A").End(xlUp).Row '获取新表格中的最后一行
k = lastrow3 + 1 '新行的行号
ws1.Rows(i).Copy Destination:=ws3.Rows(k) '复制第一个表格中的信息
ws2.Rows(j).Copy Destination:=ws3.Rows(k) '复制第二个表格中的信息
End If
Next j
Next i
'关闭工作簿并保存更改
wb1.Close SaveChanges:=False
wb2.Close SaveChanges:=False
wb3.SaveAs "文件路径3"
wb3.Close SaveChanges:=False
End Sub
```
在使用代码之前,请确保以下几点:
1. 将“文件路径1”、“文件路径2”和“文件路径3”替换为你实际使用的文件路径。
2. 确保第一个和第二个工作簿中的姓名列都是第一列(即列A)。
3. 确保新表格中的表头与第一个和第二个表格中的表头相同。
希望能对你有帮助!
阅读全文