Excel VBA 代码:匹配数据并复制到模板工作表
Excel VBA 代码:匹配数据并复制到模板工作表
本代码用于在数据工作表中查找与模板工作表 B 列数据匹配的项,并将对应的数据复制到模板工作表。代码还统计了匹配和复制的数据条数。
Sub MatchAndCopy()
Dim TemplateSheet As Worksheet
Dim DataSheet As Worksheet
Dim TemplateLastRow As Long
Dim DataLastRow As Long
Dim MatchCount As Long
Dim CopyCount As Long
' 设置模板工作表和数据工作表对象
Set TemplateSheet = ThisWorkbook.Worksheets('模板工作表')
Set DataSheet = ThisWorkbook.Worksheets('数据工作表')
' 获取模板工作表的最后一行
TemplateLastRow = TemplateSheet.Cells(TemplateSheet.Rows.Count, "B").End(xlUp).Row
' 统计匹配和复制的数据条数
MatchCount = 0
CopyCount = 0
' 遍历模板工作表的B列数据
For i = 3 To TemplateLastRow
' 获取模板工作表B列的值
Dim TemplateValue As String
TemplateValue = TemplateSheet.Range("B" & i).Value
' 在数据工作表中查找匹配项
Dim FoundCell As Range
Set FoundCell = DataSheet.Range("A:A").Find(What:=TemplateValue, LookIn:=xlValues, LookAt:=xlWhole)
' 如果找到匹配项,则复制对应的数据
If Not FoundCell Is Nothing Then
' 复制数据
TemplateSheet.Range("C" & i).Value = FoundCell.Offset(0, 1).Value
TemplateSheet.Range("D" & i).Value = FoundCell.Offset(0, 2).Value
' 统计匹配和复制的数据条数
MatchCount = MatchCount + 1
CopyCount = CopyCount + 1
Else
' 统计匹配的数据条数
MatchCount = MatchCount + 1
End If
Next i
' 显示匹配和复制的数据条数
MsgBox "匹配的数据条数:" & MatchCount & vbCrLf & "复制的数据条数:" & CopyCount
End Sub
请确保将代码中的'模板工作表'和'数据工作表'替换为实际的工作表名称。
代码功能:
- 设置模板工作表和数据工作表对象。
- 获取模板工作表的最后一行。
- 遍历模板工作表的 B 列数据,并逐行查找与数据工作表 A 列数据匹配的项。
- 如果找到匹配项,则将数据工作表中匹配项所在行的对应数据复制到模板工作表 C 和 D 列。
- 统计匹配和复制的数据条数。
- 在弹出的消息框中显示匹配和复制的数据条数。
注意:
- 代码默认从模板工作表 B3 开始遍历数据,您可以根据实际情况修改代码中的起始行号。
- 代码默认将匹配项所在行的第二列和第三列数据复制到模板工作表 C 和 D 列,您可以根据实际情况修改代码中的列号。
- 确保数据工作表 A 列的数据与模板工作表 B 列的数据类型一致,否则匹配功能可能会失效。
原文地址: https://www.cveoy.top/t/topic/gAzn 著作权归作者所有。请勿转载和采集!