1枚のシートからテキストを見つけ、それを別のシートに置き換えます。

Question

エクセルファイルに2枚のシートがあります（シート1とシート2）。

シート1には、コード、ID、テキストの3つの列があります。ここに100以上のレコードがあります。

シート2には、データのヒープがあります。私がいることをVBAを記述しようとしています

：

1）のSheet2の2列目から（シート1）「コード」を見つけました。

2）Sheet2の3番目の行から 'ID'（Sheet1）を見つけて列番号を取得します。

3）Sheet2のそれぞれの行と列に 'text'（Sheet1）を貼り付けます。

私は以下のコードを下に書かれているが、それは、それぞれの列内の「テキスト」貼り付けされていない - を支援してください。「IDは」

に一致するすべての列ではなく、ペースト。私は、ネストされたループの代わりに、ここでFind()を好む

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

ありがとう：

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