在Sheet2中根据范围search范围Sheet1根据横向单元格中的值复制到Sheet3

我search并find了一些类似的post

在工作表B中查找表A中的值，然后在相应的工作表B单元格中执行function，并且对于每个循环都不起作用在一张工作表上检索值并在另一张工作表上更改值

虽然这些都解决了我的目标的某些方面，但他们并不完全。 我有3张表1-3，如果在A列和B列find匹配或找不到匹配，那么我要在A列和B列的Sheet1 – 2中进行search和匹配，在A列中检查值以复制到Sheet3。

这是我迄今使用Office 2016的。

Public Sub SeekFindCopyTo() Dim lastRow1 As Long Dim lastRow2 As Long Dim tempVal As String lastRow1 = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row lastRow2 = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row For sRow = 4 To lastRow1 Debug.Print ("sRow is " & sRow) tempVal = Sheets("Sheet1").Cells(sRow, "B").Text For tRow = 4 To lastRow2 Debug.Print ("tRow is " & tRow) TestVal = Sheets("Sheet2").Cells(tRow, "B") Operations = Sheets("Sheet2").Cells(tRow, "A") If Sheets("SAP_XMATTERS").Cells(tRow, "B") = tempVal Then Operations = Sheets("Sheet2").Cells(tRow, "A") Debug.Print ("If = True tempVal is " & tempVal) Debug.Print ("If = True TestVal is " & TestVal) Debug.Print ("If = True Operaitons is " & Operations) If Operations = "REMOVE" Then Sheets("Sheet2").Range("A" & tRow).EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Insert xlcutcell 'Sheets("Sheet2").Rows(tRow).Delete Else 'Sheets("Sheet2").Rows(tRow).Delete End If End If Next tRow Next sRow End Sub 

代码工作得不错，但问题是，我正在寻找B：B之间的表格1和2之间的匹配如果匹配我想检查A：A中的相邻单元格stringREMOVE如果是REMOVE然后将整个行复制到sheet3 。 这里的问题我也想知道，如果在整个表格中复制整个行到sheet3，表格2和1之间的B：B与相邻单元格中的stringPROCESS没有匹配。 我可以做任何select在单独的潜艇，但不能使它在一个工作通过。

你的帮助将不胜感激，即使是沿着“你不能这样做”;-)

TIA

短发

Answer 1

使用.Find重新写了一个窍门。

 Sub SeekFindCopy() Dim sourceValue As Variant Dim resultOfSeek As Range Dim targetRange As Range LastRow = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row Set targetRange = Sheets("Sheet2").Range("B:B") For sourceRow = 4 To LastRow Debug.Print ("sRow is " & sRow) sourceValue = Sheets("Sheet1").Range("B" & sRow).Value Set resultOfSeek = targetRange.Find(what:=sourceValue, After:=targetRange(1)) 'Debug.Print (sourceValue) Operations = Sheets("Sheet1").Cells(sRow, "A") If resultOfSeek Is Nothing Then 'Debug.Print ("Operations is " & Operations) If Operations = "PROCESS" Then Sheets("Sheet1").Range("A" & sRow).EntireRow.Copy Sheets("UpLoad").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Insert xlcutcell 'Sheets("Sheet1").Rows(tRow).Delete End If Else 'Debug.Print ("Operations is " & Operations) If Operations = "REMOVE" Then Sheets("Sheet1").Range("A" & sRow).EntireRow.Copy Sheets("UpLoad").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Insert xlcutcell 'Sheets("Sheet1").Rows(tRow).Delete End If End If Next sourceRow End Sub