VBA, как скопировать соответствующие значения столбца из другой книги, если значения совпадают

Question

Я провел несколько исследований относительно Excel VBA.Но я все еще не могу найти решение своей проблемы.

Причина, по которой я использую макросы, заключается в том, что это нужно делать еженедельно.Что нужно сделать макросам, когда значения соответствуют столбцу A (столбец элемент ) из обеих книг, он скопирует запас нераспределения из книги 2 (столбец H) в (столбец C)в рабочей тетради 1.

рабочая тетрадь 2

рабочая тетрадь 1

Ниже частичный код, который не работает.Не стесняйтесь делиться своим собственным кодом, потому что я не очень хорош в VBA.(если возможно, пожалуйста, включите комментарий, чтобы мне было легче понять)

  FindString = ws1.Range("A" & j) 'stock item number
  If Trim(FindString) <> "" Then ' if item number not equal to blank
    With ws3.Range("A:A") 'searches all of column A of sum up sheet
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.count), _
                       LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
         '---If intersite exists in ws3
                '---------VLOOKUP ------------

        'If (ws1.Range("H" & j).Value > ws3.Range("B" & j).Value) Then

          ' here = Rng.Row


            'ws1.Range("A" & j & ":R" & j).Copy ws4.Range("A" & lrow4)              'Copy stockworkbook range A(j) until R(j)  until paste to worksheet Output
            'lrow4 = ws4.Cells(ws4.Rows.count, "A").End(xlUp).Row + 1                 'lastrow tambah 1

          ws1.Range("H" & j).Copy ws3.Range("c" & lrow4)
          lrow4 = ws3.Cells(ws4.Rows.count, "c").End(xlUp).Row + 1

Изображение: нет ошибок в кодировании, но вывод неправильный

Изображение: результатпустого вывода в столбце C

Answer 1

попробуйте это:

WIP WIP: ссылка на рабочую книгу. Рабочий лист не возможен WIP

    Dim i as Integer 'will run through workbook 2
    Dim j as Integer 'will run through workbook 1

    Dim wbOne as Workbook
    Set wbOne = Workbook("WorkbookOne")
    Dim wbTwo as Workbook
    Set wbTwo = Workbook("WorkbookTwo") 'replace with correct naming

    Dim wsOne as Worksheet
    Set wsOne = Worksheets("WorksheetOne")
    Dim wsTwo as Worksheet
    Set wsTwo = Worksheets("WorksheetTwo")


    for i = 1 to 1000 'length wb1
        for j = 1 to 10000 'length wb2
            if wbTwo.wsTwo.cells(i,1).value = wbOne.wsOne.cells(j,1).value then 
                wbTwo.wsTwo.cells(i,3).value = wbOne.wsOne.cells(j,8).value
                exit for 'exit j loop because match was found
            end if
        next j
    next i

вы можете динамически регулировать длину ваших рабочих книг.Если if-утверждение не понятно, просто спросите.Еще один совет: у вас, похоже, большой объем данных, поэтому двойной цикл может занять много времени для вычисления.Вы можете сделать эту программу радикально быстрее, сохранив все данные в массивах, а затем выполнив двойной цикл для массивов.