VBA，根据指定图纸中的标识符列合并图纸中的表

我是VBA新手。我有两张表，其中包含两个表。表1是标题“材料”下一列中的缩略语词汇表，以及标题“材料说明”下一列中的说明。表2是一个数据集，包含标题“客户名称”下的一列、标题“物料”下的一列和标题“发票价值”下的一列

例如：

Sheet 1      
Material    Material Description
   X               Hot
   B               Cold
   C               Temp
-------------------------------------
Sheet 2       
Material       Invoice Value
   X               2.7645  
   X               3.9
   B               4.6

期望输出：

Sheet 3
Material        Invoice Value
   Hot               2.7645  
   Hot               3.9
  Cold               4.6

我正在努力：

在相应的工作表中查找具有指定标题的列

对于表1的每一行和每一列“材料”，查找表2中与表1中相同“材料”对应的“材料”

将第2页“材料”列中的文本替换为第1页中“材料说明”的相应值

对于第1项，我已经了解到：

Sub Replace()

    Dim startrow As Long
    Dim custrng As Range
    Dim matdatrng As Range
    Dim valrng As Range
    Dim dscrng As Range
    Dim matname As Range

    startrow = 2

    Set rcustrng = Worksheets("Data").UsedRange.Find("Customer Name", , xlValues, xlWhole)
    Set matdatrng = Worksheets("Data").UsedRange.Find("Material", xlValues, xlWhole)
    Set valrng = Worksheets("Data").UsedRange.Find("Invoiced Value", xlValues, xlWhole)
    Set matname = Worksheets("Names").UsedRange.Find("Material", xlValues, xlWhole)
    Set dscrng = Worksheets("Names").UsedRange.Find("Material Description", xlValues, xlWhole)

End Sub

---

非常感谢您提供的任何帮助/建议，我希望将其扩展到三个数据集。

我可以使用以下链接中的代码来完成这项工作，该链接由腮腺炎提供：

---

很棒的代码，节省了我大量的时间。

所以你想循环浏览sheet2中的材质，如果有匹配项，请将材质描述粘贴到sheet2中的材质下？你的代码没有太多功能，它只找到标题的范围，这并不重要，你有很多行，比如10k或其他行吗？你需要一步一步地简化问题，这不是一个困难的代码，但由于你要求1-2-3等成员没有参与你正在做的很多工作demanding@Ibo感谢您的反馈，我编辑并添加了一个简单的示例，该示例将阐明代码的使用和输出，我有10k+列和30多行，但是，由于代码将被推广到包含这些标题的列的工作表中，因此我需要在VBA@Ibo抱歉，30列和10k+rows@EI_1988您有许多行，因此最好使用数组和字典来加快速度。我假设所有工作表中的所有标题都在第1行，并且所有这些特定列都是第1、2、3列，或者它们位于应该首先找到的不同列中？

Sub CopyRange()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("OCData").Cells.Find("*", SearchOrder:=xlByRows,      SearchDirection:=xlPrevious).Row
Dim ID As Range
Dim foundID As Range
For Each ID In Sheets("OCData").Range("C2:C" & LastRow)
    Set foundID = Sheets("NamesList").Range("B:B").Find(ID, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundID Is Nothing Then
        Sheets("NamesList").Range("B" & foundID.Row & ":E" & foundID.Row).Copy Sheets("OCData").Range("J" & ID.Row)
    End If
Next ID
Application.ScreenUpdating = True
End Sub