Excel VBA - поиск значения из листа1 в листе 2 и обновление со смежным значением из листа1

Question

Я пытаюсь написать некоторый код VBA, который будет принимать первое значение в списке уникальных значений в столбце A на sheet2 и искать его по уникальным значениям в столбце A на sheet1. Найдя, он обновит ячейку 6 справа от активной ячейки на sheet1 со значением, смежным с уникальным кодом в sheet2. Это будет продолжаться, пока не будет достигнута пустая ячейка до конца списка в sheet2.

Мне удалось получить код, чтобы найти уникальные значения, а затем обновить ячейку 6 вправо, добавив 1, но я не могу обработать другой бит:

    Private Sub SinglePaste_Click()
    On Error GoTo InvalidBarcode
    Dim EAN As Range
        Sheets("Paste Here").Select
          For Each EAN In ActiveSheet.Range("A:A")
          Sheets("Master Stock File").Select
          With Worksheets("Master Stock File")
          .Range("A:A").Find(What:=EAN, After:=.Range("A1"), LookIn:=xlFormulas, _
          LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
          MatchCase:=False).Activate
        ActiveCell.Offset(0, 6).Select
        ActiveCell.Value = ActiveCell.Value + 1
       End With
      If IsEmpty(EAN) Then Exit For
      Next EAN
     Exit Sub
    InvalidBarcode:
    MsgBox ("Invalid Barcode - " & "" & EAN)
    End Sub

Имеет ли это смысл? Любая помощь с благодарностью.

Answer 1

В вашем коде используется много ActiveSheet, ActiveCell и Select, что свидетельствует о записи макросов и, как правило, менее эффективно.Я все еще не уверен, что означает «другой бит», но вот переработанный макрос:

Public Sub NewSinglePaste_Click()
  Dim EAN As Range
  Dim FoundRange As Range
  Dim ValueCell As Range
  Dim MasterSheet As Worksheet
  Dim PasteSheet As Worksheet

  Set MasterSheet = Sheets("Master Stock File")
  Set PasteSheet = Sheets("Paste Here")

  On Error GoTo InvalidBarcode
  For Each EAN In PasteSheet.Range("A:A")
    If IsEmpty(EAN.Text) Or EAN.Text = "" Then Exit For

    Set FoundRange = MasterSheet.Range("A:A").Find(What:=EAN, _
      After:=MasterSheet.Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, _
      SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

    If Not (FoundRange Is Nothing) Then
      Set ValueCell = FoundRange.Offset(0, 6)
      ValueCell.Value = ValueCell.Value + 1
    Else
      Debug.Print "Cell not found: " & EAN.Worksheet.Name & "!" & EAN.Address
    End If
  Next EAN

  Exit Sub

InvalidBarcode:
    MsgBox ("Invalid Barcode - " & "" & EAN)

End Sub