然后从一个单元格中查找string中的文本，然后将值从相应的行复制到另一个单元格

这是我想要发生的事情：
在Sheet2的A列中，每个单元格包含一个电子邮件主题行。 我希望macros查看每个单元格，并查看是否在主题行中的某处find了来自Sheet1的D列的单元格。

然后，当发现这种情况时，我想复制来自Sheet1中的行的信息，该行对应于单元格被find的主题行的同一行中的表格2中列D到列B的单元格。

在macros运行之前，这是Sheet1：

这是macros运行之前的sheet2：

这是我有这个不能正常工作的代码：

Sub Path() Dim rCell As Range Dim rRng As Range Sheets("Sheet2").Activate Set rRng = Range("A2:A65000") With Sheets(1).Activate For i = 1 To Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row For Each rCell In rRng.Cells If InStr(1, rCell, Sheets("Sheet1").Cells(i, "E").Value, vbTextCompare) Then Sheets("Sheet2").Cells(i, "B") = "1. Invoices+BUFs - " & Sheets("Sheet1").Range("B65000").End(xlUp).Value & "\" & Sheets("Sheet1").Range("A65000").End(xlUp).Value & " - " & Sheets("Sheet1").Range("C65000").End(xlUp).Value & "\" & "LOGGED" & "\" & Sheets("Sheet1").Range("D65000").End(xlUp).Value End If Next rCell Next i End With End Sub 

这是macros运行后发生的情况：

这是我想要的结果：

Answer 1

这段代码应该返回所需的结果：

 Sub Path() Dim s1 As Worksheet Dim s2 As Worksheet Dim i As Long Dim j As Long Set s1 = ActiveWorkbook.Sheets("Sheet1") Set s2 = ActiveWorkbook.Sheets("Sheet2") Application.ScreenUpdating = False 'Loop sheet 2 For i = 1 To s2.Cells(Rows.Count, 1).End(xlUp).Row 'Loop sheet 1 For j = 1 To s1.Cells(Rows.Count, 1).End(xlUp).Row 'If match found If Not InStr(1, s2.Cells(i, 1).Value, s1.Cells(j, 4).Value) = 0 Then s2.Cells(i, 2).Value = "1. Invoices+BUFs - " & s1.Cells(j, 2).Value & "\" & s1.Cells(j, 1).Value & " - " & s1.Cells(j, 3).Value & "\" & "LOGGED" & "\" & s1.Cells(j, 4).Value Exit For End If Next j Next i Application.ScreenUpdating = True End Sub 

Answer 2

每当填写Sheet2中的“B”列时，您只需进入Sheet1的最后一行，即可：

 Sheets("Sheet2").Cells(i, "B") = _ MAIN_PATH & "1. Invoices+BUFs - " & _ Sheets("Sheet1").Range("B65000").End(xlUp).Value & "\" & _ Sheets("Sheet1").Range("A65000").End(xlUp).Value & " - " & _ Sheets("Sheet1").Range("C65000").End(xlUp).Value & "\" & "LOGGED" & "\" & _ Sheets("Sheet1").Range("D65000").End(xlUp).Value 

尝试这个 ：

 Sub Path() Dim rCell As Range Dim rRng As Range Set rRng = Sheets("Sheet2").Range("A2:A" & Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row) With Sheets("Sheet1") For Each rCell In rRng.Cells For i = 1 To .Cells(Rows.Count, "D").End(xlUp).Row If Sheets("Sheet2").Cells(rCell.Row, "B") <> "FILLED" Then If InStr(1, rCell, .Cells(i, "E").Value, vbTextCompare) Then Sheets("Sheet2").Cells(rCell.Row, "B") = _ "1. Invoices+BUFs - " & _ .Cells(i, "B") & "\" & _ .Cells(i, "A") & " - " & _ .Cells(i, "C") & "\" & _ "LOGGED" & "\" & _ .Cells(i, "D") Exit For End If Else End If Next i Next rCell End With Set rRng = Nothing End Sub