从一张纸中查找文本并用它来替换另一张纸

Question

我的 excel 文件中有 2 张表（表 1 和 2）。

在工作表 1 中，有 3 列 - 代码、ID 和文本。这里有100多条记录。

在工作表 2 中，有大量数据。

我正在尝试编写 VBA：

1) 从 Sheet2 的第二列中找到“代码”（Sheet1）；

2) 从Sheet2的第三行查找'ID'（Sheet1）并获取列号；

3) 将“文本”(Sheet1) 粘贴到 Sheet2 的相应行和列中。

我已经写下了下面的代码，但它没有在相应的列中粘贴“文本”-而是粘贴到与“ID”匹配的所有列中

请帮忙。谢谢

Private Sub CommandButton1_Click()

Dim wb As Workbook
Dim sht As Worksheet
Dim rng1 As Range
Dim rngCell_1 As Range
Dim rngCell_2 As Range
Dim rngCell_3 As Range

Set wb = ActiveWorkbook
Set sht2 = ActiveWorkbook.Sheets("Sheet2")
Set sht = wb.Sheets("Sheet1")

With sht2

lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
lastrowcell = sht.Cells(Rows.Count, "A").End(xlUp).Row
For Row = 4 To lastrow
    For Each rngCell_2 In sht.Range("B2:B" & lastrowcell)
    Set rng1 = sht2.UsedRange.Find(rngCell_2, , xlValues, xlWhole)
        For Each rngCell_1 In sht.Range("A2:A" & lastrowcell)
            For Each rngCell_3 In sht.Range("C2:C" & lastrowcell)
                If (.Cells(Row, 2) = rngCell_1) Then
                    .Cells(Row, rng1.Column) = rngCell_3
                    .Cells(Row, rng1.Column).Font.Color = 255
                    End If
            Next rngCell_3
        Next rngCell_1
    Next rngCell_2
Next Row
End With

End Sub

Answer 1

我更喜欢Find() 代替嵌套循环：

Private Sub CommandButton1_Click()

    Dim wb As Workbook
    Dim sht1 As Worksheet, sht2 As Worksheet
    Dim rw As Range, f1 As Range, f2 As Range

    Set wb = ActiveWorkbook
    Set sht1 = wb.Sheets("Sheet1")
    Set sht2 = wb.Sheets("Sheet2")

    Set rw = sht1.Range("A2:C2")

    Do While Application.CountA(rw) = 3

        Set f1 = sht2.Columns(2).Find(rw.Cells(1), lookat:=xlWhole)

        If Not f1 Is Nothing Then

            Set f2 = sht2.Rows(2).Find(rw.Cells(2), lookat:=xlWhole)

            If Not f2 Is Nothing Then
                sht2.Cells(f1.Row, f2.Column).Value = rw.Cells(3).Value
            End If

        End If

        Set rw = rw.Offset(1, 0)
    Loop

End Sub