Question

处理一个看起来很简单的问题，但出于某种原因我不能让它发挥作用。

我有一个数据输入表我试图将值与另一张表匹配，这些值都在E列中，E列中的所有值都是唯一的。这些值将始终存储在第8行到第2500行。

我的代码如下，但是在线上抛出了有用的1004错误（应用程序定义或对象定义的错误）

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

任何帮助将不胜感激：

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.并且没有任何理由使用{{转换为字符串1}}，因为连接会将整个范围参数转换为字符串。

Answer 2

通常在比较两个不同工作表中的两个不同列时，您会看到一个双循环，第一个循环通过sheet1，第二个循环获取sheet1的每个值并循环通过sheet2来查找匹配。在阅读您的描述时，我认为这就是您想要的。

双循环可能是时间密集的。还有另一种方式，Worksheetfunction.match !!

我还注意到您的代码多次选择/激活工作表。通常，如果声明并实例化所需的变量，则不需要选择/激活工作表。

下面是一个示例代码，我尝试尽可能地使其即插即用，但我不确定您正在循环的工作表的名称。我已经测试了虚拟数据上的代码，它似乎有效，但我再次对应用程序不太积极。我已经对代码进行了评论，以尽可能多地解释该过程。希望它有所帮助。干杯！

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

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

2 个答案: