Добавить в таблицу отсутствующие значения

[Poltava]

Доброго всем времени суток. Есть таблица на несколько тысяч строк к ней из другой таблицы нужно добавить те значения которых в ней нет. Сейчас реализую таким образом. В пустую ячейку добавляю формулу которой через ВПР ищу значения в первой таблице если формула вернула ошибку значит такой позиции в базе нет и ее нужно добавить потом фильтрую результат автофильтром и копирую полученные данные в конец таблицы на первом листе. В принципе можно написать макрос который будет делать это все автоматом и все но вот тут я предвижу следующие проблемы. База состоит где то из 15000 строк при выше описанном способе потребуется пересчет листа а это занимает немало времени в среднем около трех минут. Отсюдова вопрос как все это лучше реализовать есть ли способ который будет работать быстрее чем то что я предложил выше. Пример базы во вложении

[exceleved]

Для начала - упростите формулу

Код Выделить Развернуть

=ПОИСКПОЗ(A2;base;0)
или
=ЕНД(ПОИСКПОЗ(A2;base;0))Таблица-то состоит из одного столбца или из нескольких?

[Poltava]

А за формулы спасибо не знаю почему сразу не подумал сделать так может и в правду быстрей будет работать
1 колонка это тот столбец в который нужно подтянуть недостающие значения помимо нее татам еще куча данных
На первом листе это около 15 колонок и часть из них вычисляться формулами и подтягивает через ВПР данные из других листов
на втором листе таблица состоит чисто из набора значений в 5 колонках. Но подтянуть нужно только в этот столбец и из того столбца

[_Boroda_]

Поскольку у Вас 2007 (или 2010), то можно так (должно быть довольно быстро):

Код Выделить Развернуть

Sub tt()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
ac_ = Application.Calculation
Application.Calculation = xlCalculationManual
'Первая таблица
    r10_ = 1 'первая строка таблицы
    r11_ = Лист1.Range("A" & Rows.Count).End(xlUp).Row 'последняя строка таблицы
'Вторая таблица
    r20_ = 2 'первая строка таблицы
    r21_ = Лист2.Range("A" & Rows.Count).End(xlUp).Row 'последняя строка таблицы
With Лист1
    .Range("A" & r11_ + 1 & ":A" & r11_ + 1 + r21_ - r20_) = Лист2.Range("A" & r20_ & ":A" & r21_).Value
    .Range("A" & r10_ & ":A" & r11_ + 1 + r21_ - r20_).RemoveDuplicates Columns:=1, Header:=xlNo
    r00_ = .Range("A" & Rows.Count).End(xlUp).Row
    Лист1.Range("A" & r10_ & ":A" & r00_) = .Range("A1:A" & r00_).Value
End With
Лист1.Range("A" & r10_).Copy
Лист1.Range("A" & r10_ & ":A" & r00_).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Application.Calculation = ac_
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub


[Poltava]

Спасибо в 2007 действительно работает без проблем. Узнал из примера много интересного
Но вот проблема в том что все должно работать в 2003 экселе

[kuklp]

Видел дату последнего ответа, но может ТС будет интересно:-)

Код Выделить Развернуть

Public Sub www()
    Dim a, b, i&, n&
    a = Me.[a1].CurrentRegion.Value
    ReDim b(1 To UBound(a, 1) + Sheets(2).UsedRange.Rows.Count, 1 To 1)
    With CreateObject("scripting.dictionary")
    For i = 1 To UBound(a)
        If Not .exists(a(i, 1)) Then _
         n = n + 1: .Item(a(i, 1)) = n: b(n, 1) = a(i, 1)
    Next
    a = Sheets(2).[a1].CurrentRegion.Value
    For i = 2 To UBound(a)
        If Not .exists(a(i, 1)) Then _
         n = n + 1: .Item(a(i, 1)) = n: b(n, 1) = a(i, 1)
    Next
    End With
    Sheets(1).[a1].Resize(n, 1) = b
End Sub

[Poltava]

Спасибо. Посмотрел бегло вроде то что нужно. Завтра буду разбираться. Спасибо за ответ.