在sheet（x）列（x）中查找值，如果它们与粘贴行匹配，则与sheet（y）列（y）中的值匹配

Question

Dealing with an issue that seems simple enough, but for some reason I cannot get this to work.

I have a data input sheet I am trying to match values across to another sheet, the values are both in column E, and all the values in column E are unique. The values will always be stored in rows 8 though to 2500.

My code is as below, however is throwing the ever useful 1004 error (Application-Defined or object-defined error), on line

If Sheets("Target Inputs").Range("E" & CStr(LSearchRow)).Value = searchTerm Then

any help would be greatly appreciated:

Sub LOAD_BUID_Lookup()

Dim i As Integer
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim searchTerm As String

On Error GoTo Err_Execute

For i = 8 To 2500
  searchTerm = Range("E" & i).Text
  If Sheets("Target Inputs").Range("E" & CStr(LSearchRow)).Value = searchTerm Then

     'Select row in Sheet1 to copy
     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
     Selection.Copy

     'Paste row into Sheet2 in next row
     Sheets("LOAD").Select
     Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
     ActiveSheet.Paste

     'Move counter to next row
     LCopyToRow = LCopyToRow + 1

     'Go back to Sheet1 to continue searching
     Sheets("Target Inputs").Select

  End If
Next i

Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
   MsgBox "An error occurred."

End Sub

Answer 1

没有将LSearchRow设置为任何值，这意味着它为0。这又引发了异常，因为行号不能为0。而且没有任何理由使用CStr转换为字符串，因为串联会转换整个范围参数仍然是字符串。

Answer 2

Usually when comparing two different columns in two different sheet you would see a double loop the first to loop through sheet1 and the second to take every value of sheet1 and loop through sheet2 to find a match. In reading your description I think this is what you want.

Double loops can be time intensive. There is another way, Worksheetfunction.match !!

I also noticed your code selecting/activating sheets multiple times. Typically selecting/activating sheets is not required if you declare and instantiate the variables you need.

Below is an example code I tried to make it as plug and play as possible, but I wasn't sure of the name of the sheet you are looping through. I've tested the code on dummy data and it seems to work, but again I'm not quite positive on the application. I've commented the code to explain as much of the process as possible. Hopefully it helps. Cheers!

Option Explicit 'keeps simple errors from happening
Sub LOAD_BUID_Lookup()

'Declare variables
Dim wb As Workbook
Dim wsInputs As Worksheet
Dim wsTarget As Worksheet
Dim wsLoad As Worksheet
Dim searchTerm As String
Dim matchRng As Range
Dim res
Dim i As Integer


'instantiate variables
Set wb = Application.ThisWorkbook
Set wsInputs = wb.Worksheets("Inputs") 'unsure of the name of this sheet
Set wsTarget = wb.Worksheets("Target Inputs")
Set wsLoad = wb.Worksheets("LOAD")
Set matchRng = wsTarget.Range("E:E")


On Error GoTo Err_Execute

For i = 8 To 2500
  searchTerm = wsInputs.Range("E" & i).Text 'can use sheet variable to refer exactly to the sheet you want without selecting

    'get match if one exists
    On Error Resume Next
    res = Application.WorksheetFunction.Match(searchTerm, matchRng, 0) 'will return a row number if there is a match
    If Err.Number > 0 Then  'the above command will throw an error if there is no match
        'MsgBox "No Match!", vbCritical
        Err.Clear ' we clear the error for next time around
        On Error GoTo 0 'return to previous error handeling
    Else
        On Error GoTo 0 'return to previous error handeling
        wsInputs.Range("A" & i).EntireRow.Copy Destination:=wsLoad.Range("A" & wsLoad.Range("E50000").End(xlUp).Row + 1) 'gets last row and comes up to last used row ... offset goes one down from that to the next empty row

    End If


Next i

'Application.CutCopyMode = False -- there is no need for this when we use "Destination"

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
   MsgBox "An error occurred."

End Sub