Добавление строк с отсутсвующими значениями

[zenner]

Добрый день! У меня есть следующий файл:For forum.zip

Подскажите пожалуйста макрос который найдет в колонке "А" пропущенные номера телефонов и вставит их в соответствующие места. Диапазон нумерации: 353100 - 353891 Спасибо!

[Hugo121]

В общем получился такой корявый код (вероятно можно где-то оптимизировать, но и так работает):

Sub tt()
    Dim i&, ii&, il&
    Application.ScreenUpdating = False
    [h1].Select
    ii = 353891
    il = Cells(Rows.Count, 4).End(xlUp).Row

    For i = il To 2 Step -1
        Do While Cells(i, 1) < ii
            Cells(i + 1, 1).EntireRow.Insert
            Cells(i + 1, 1) = ii
            ii = ii - 1
        Loop
        ii = ii - 1
    Next
    Application.ScreenUpdating = True
End Sub

Но! На Ваших данных будет ошибка в одном месте - там 2 раза строка 353411.

[zenner]

Спасибо за помощь! да, я тоже заметил что одна строка повторяется но ошибку мне макрос не выдает.

[Hugo121]

Он и у меня ошибку не выкидывает - просто там нарушается последовательность.

Вообще можно было сделать алгоритм совершенно другой - индексируем словарём массив существующих данных, затем в другом массиве собираем эти номера по порядку - существующим заполняем дааные из существующего массива, новые пишутся без данных.
Выгружаем результат на лист (любой).
Так в общем результат будет похож, но без добавления строк в существующую таблицу (т.е. таблица будет сделана другая из этих и сгенерённых данных). Зато исходный порядок номеров может быть любым, и повтор номеров будет игнорироваться (можно предусмотреть, что делать в таком случае).

[zenner]

Hugo121,

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

[Hugo121]

Что-то не получается на Вашем примере сделать...
Так может сделать по плану Б - на словаре? Тогда повторы можно просто игнорировать (или сразу решить, какой из них будем брать), и из исходных данных создать новый лист с полным списком номеров.

[zenner]

Сообщение от Hugo121

Что-то не получается на Вашем примере сделать...
Так может сделать по плану Б - на словаре? Тогда повторы можно просто игнорировать (или сразу решить, какой из них будем брать), и из исходных данных создать новый лист с полным списком номеров.

Для меня было бы хорошо чтобы макрос игнорировал повторы но чтобы хотя бы выделял их цветом и добавлял отсутствующие номера в том же рабочем листе. Спасибо!!!

[Hugo121]

Пробуйте план Б:

Sub tt()
    Dim a(), i&, ii&, x As Byte
    a = Sheets("ST").[a1].CurrentRegion.Offset(1).Value
    ReDim b(1 To 353891 - 353100 + 1, 1 To 5)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
        If Len(a(i, 1)) Then .Item(a(i, 1)) = i
        Next
        For ii = 353100 To 353891
            If .exists(ii) Then
                For x = 1 To 5
                    b(ii - 353100 + 1, x) = a(.Item(ii), x)
                Next
            Else
                b(ii - 353100 + 1, 1) = ii
            End If
        Next
    End With
    Sheets("ST").[a2:e2].Resize(UBound(b)).Value = b
End Sub