Suchen Sie Texte von einem Blatt und ersetzen Sie sie in einem anderen Blatt

Question

Es gibt zwei Blätter in meiner Excel-Datei (Blatt 1 und 2).

In Blatt 1 gibt es 3 Spalten - Code, ID und Text. Es gibt mehr als 100 Datensätze hier.

In Blatt 2 gibt es eine Menge Daten.

Ich versuche, VBA zu schreiben, dass:

1) Funde 'Code' (Sheet1) aus der zweiten Spalte von Sheet2;

2) findet 'ID' (Sheet1) aus der dritten Zeile von Sheet2 und erhält die Spaltennummer;

3) Fügen Sie 'text' (Sheet1) in die entsprechende Zeile und Spalte in Sheet2 ein.

ich geschrieben habe den Code unten nach unten, aber es ist nicht das Einfügen ‚Text‘ in der jeweiligen Spalte - eher Pasten in allen Spalten Anpassung der ‚IDs‘

Bitte unterstützen. Dank

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

I Find() hier anstelle von verschachtelten Schleifen bevorzugen würde:

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