Скопируйте новые записи между 2 листами, если значение ячейки совпадает

Вопрос или проблема

Я использую приведенный ниже код VBA, но он копирует все записи с начала и из-за этого зависает ноутбук. Пожалуйста, помогите, чтобы переносить только новые записи.

Спасибо.

Sub CopyRowsWithNUMBER()

Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet


Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")

j = 1     
For Each c In Source.Range("F1:F20")   
    If c = "Numbers" Then
       Source.Rows(c.Row).Copy Target.Rows(j)
       j = j + 1
    End If
Next c
End Sub

Ответ или решение

Конечно! Давайте оптимизируем ваш код VBA для копирования только новых записей между двумя листами Excel, избегая при этом дублирования и возможных зависаний. Мы добавим логику, которая будет проверять, существует ли уже скопированное значение в целевом листе.

Вот обновленный код:

Sub CopyNewRowsWithNUMBER()
    Dim c As Range
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim j As Integer
    Dim lastRow As Long
    Dim foundCell As Range

    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Sheet2")

    ' Ищем последнюю заполненную строку на целевом листе
    lastRow = Target.Cells(Target.Rows.Count, "A").End(xlUp).Row ' Предположим, что данные начинаются с колонки A

    j = lastRow + 1 ' Начинаем копировать с первой пустой строки в целевом листе

    For Each c In Source.Range("F1:F20")   
        If c.Value = "Numbers" Then
            ' Проверяем, существует ли такая же строка в целевом листе
            Set foundCell = Target.Columns(1).Find(What:=Source.Rows(c.Row).Cells(1, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
            If foundCell Is Nothing Then
                ' Если не найдено, копируем строку
                Source.Rows(c.Row).Copy Target.Rows(j)
                j = j + 1
            End If
        End If
    Next c
End Sub

Объяснение кода:

  1. Инициализация переменных: Мы объявляем переменные для источника, цели и другие вспомогательные переменные.
  2. Определение последней строки: Мы ищем последнюю заполненную строку в целевом листе (Sheet2) с помощью функции End(xlUp), чтобы начать вставку новых данных только после последних существующих записей.
  3. Цикл по диапазону: Цикл проходит по строкам F1:F20 источника (Sheet1). Если значение в ячейке равно "Numbers", тогда мы продолжаем проверку.
  4. Проверка на дубликаты: С помощью метода Find мы проверяем, существует ли уже строка с таким же значением в целевом листе. Если нет, то выполняем копирование.
  5. Копирование: Новая строка копируется в следующую пустую строку на целевом листе.

Важные моменты:

  • Убедитесь, что параметр поиска (Column(1)) указывает на нужную колонку, соответственно вашей структуре данных.
  • Если ваши данные находятся в других колонках, возможно, потребуется скорректировать код.
  • Обратите внимание на диапазон, который вы проверяете (в данном случае F1:F20) – если вы хотите проверить больше строк, вам нужно расширить этот диапазон.

С помощью данной оптимизации ваш код будет работать более эффективно, избегая дублирования и предотвращая зависание системы. Если возникнут дополнительные вопросы или потребуется дальнейшая помощь, не стесняйтесь задавать их!

Оцените материал
Добавить комментарий

Капча загружается...