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

请确保将代码中的'模板工作表'和'数据工作表'替换为实际的工作表名称。

代码功能:

  1. 设置模板工作表和数据工作表对象。
  2. 获取模板工作表的最后一行。
  3. 遍历模板工作表的 B 列数据,并逐行查找与数据工作表 A 列数据匹配的项。
  4. 如果找到匹配项,则将数据工作表中匹配项所在行的对应数据复制到模板工作表 C 和 D 列。
  5. 统计匹配和复制的数据条数。
  6. 在弹出的消息框中显示匹配和复制的数据条数。

注意:

  • 代码默认从模板工作表 B3 开始遍历数据,您可以根据实际情况修改代码中的起始行号。
  • 代码默认将匹配项所在行的第二列和第三列数据复制到模板工作表 C 和 D 列,您可以根据实际情况修改代码中的列号。
  • 确保数据工作表 A 列的数据与模板工作表 B 列的数据类型一致,否则匹配功能可能会失效。
Excel VBA 代码:匹配数据并复制到模板工作表

原文地址: https://www.cveoy.top/t/topic/gAzn 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录