Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Отобразить отсутствующие в промежутке номера - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Отобразить отсутствующие в промежутке номера (Макросы/Sub)
Отобразить отсутствующие в промежутке номера
AVI Дата: Среда, 10.10.2018, 04:01 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
Добрый день!
Год назад в этой теме http://www.excelworld.ru/forum/2-34294-1 уважаемая Pelena решила мою задачу. Мне нужно было построить ряд целых чисел, которые отсутствую в промежутке от 1 до номера квартиры. В примере: в массиве M2:N4952 -адреса с квартирами, которые есть в базе. В массиве Q2:R48 адреса домов с максимальным номером квартиры в этом доме. Функция работает прекрасно, но с большими диапазонами ооочень медленно. На обработку только 200 (из 15000) адресов (при условии поиска 15-ти тысяч адресов в 700-стах тысяч квартир) у нее уходит минут 25-30. Вот уже третий день я абсолютно безуспешно пытаюсь ускорить работу функции с помощью словарей. Но дальше определения диапазонов и формирования словаря я нисколько не продвинулся, при этом, я совершенно никак не могу сообразить как прописать условия поиска. Знаю, что можно прописать функцию в самом коде со словарем, но будет ли это быстрее работать? Или этот алгоритм поиска можно прописать в самом коде без использования функции?
К сообщению приложен файл: ____.xlsm(83.9 Kb)
 
Ответить
СообщениеДобрый день!
Год назад в этой теме http://www.excelworld.ru/forum/2-34294-1 уважаемая Pelena решила мою задачу. Мне нужно было построить ряд целых чисел, которые отсутствую в промежутке от 1 до номера квартиры. В примере: в массиве M2:N4952 -адреса с квартирами, которые есть в базе. В массиве Q2:R48 адреса домов с максимальным номером квартиры в этом доме. Функция работает прекрасно, но с большими диапазонами ооочень медленно. На обработку только 200 (из 15000) адресов (при условии поиска 15-ти тысяч адресов в 700-стах тысяч квартир) у нее уходит минут 25-30. Вот уже третий день я абсолютно безуспешно пытаюсь ускорить работу функции с помощью словарей. Но дальше определения диапазонов и формирования словаря я нисколько не продвинулся, при этом, я совершенно никак не могу сообразить как прописать условия поиска. Знаю, что можно прописать функцию в самом коде со словарем, но будет ли это быстрее работать? Или этот алгоритм поиска можно прописать в самом коде без использования функции?

Автор - AVI
Дата добавления - 10.10.2018 в 04:01
boa Дата: Среда, 10.10.2018, 11:01 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 278
Репутация: 57 ±
Замечаний: 0% ±

2013, 365
AVI, здравствуйте,
вариант со словарем во вложении(Module2). Сам листинг под спойлером.
Ваш список из 5 тыс. записей обрабатывается за 0,8 сек.
К сообщению приложен файл: _11.xlsm(94.8 Kb)




Сообщение отредактировал boa - Среда, 10.10.2018, 14:23
 
Ответить
СообщениеAVI, здравствуйте,
вариант со словарем во вложении(Module2). Сам листинг под спойлером.
Ваш список из 5 тыс. записей обрабатывается за 0,8 сек.

Автор - boa
Дата добавления - 10.10.2018 в 11:01
SLAVICK Дата: Среда, 10.10.2018, 11:13 | Сообщение № 3
Группа: Модераторы
Ранг: Старожил
Сообщений: 2286
Репутация: 751 ±
Замечаний: 0% ±

2019
Можно сводной таблицей сделать.(в 2016+)
Данных немного поудалял, но всеравно в 100кб не влез - поэтому два архива
Алгоритм явно можно сократить - но лениво. :D .
К сообщению приложен файл: -1-part1.rar(99.0 Kb) · -1-part2.rar(17.4 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеМожно сводной таблицей сделать.(в 2016+)
Данных немного поудалял, но всеравно в 100кб не влез - поэтому два архива
Алгоритм явно можно сократить - но лениво. :D .

Автор - SLAVICK
Дата добавления - 10.10.2018 в 11:13
sboy Дата: Среда, 10.10.2018, 11:45 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 2238
Репутация: 634 ±
Замечаний: 0% ±

Excel 2010
Вариант на Power Query
К сообщению приложен файл: 0065618.xlsb(70.4 Kb)
 
Ответить
СообщениеВариант на Power Query

Автор - sboy
Дата добавления - 10.10.2018 в 11:45
AVI Дата: Среда, 10.10.2018, 13:31 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
boa, что-то я не понял как работает. Я выбрал диапазон - нажал ОК и просто открылся пустой лист.
SLAVICK, Сводную сдуру погнал по всем оригинальному файлу:"идет извлечение фалов" уже 35 минут... и вылезло сообщение, что заканчивается свободная память на ssd-шнике... свободной было 45 гб...
sboy, с Power Query у меня еще хуже, чем с макросами. Я просто не понимаю как это работает.

[offtop]Главный вопрос: куда делось место и как его вернуть после сводной)))))))))))))))))))))))[/offtop]


Сообщение отредактировал AVI - Среда, 10.10.2018, 13:44
 
Ответить
Сообщениеboa, что-то я не понял как работает. Я выбрал диапазон - нажал ОК и просто открылся пустой лист.
SLAVICK, Сводную сдуру погнал по всем оригинальному файлу:"идет извлечение фалов" уже 35 минут... и вылезло сообщение, что заканчивается свободная память на ssd-шнике... свободной было 45 гб...
sboy, с Power Query у меня еще хуже, чем с макросами. Я просто не понимаю как это работает.

[offtop]Главный вопрос: куда делось место и как его вернуть после сводной)))))))))))))))))))))))[/offtop]

Автор - AVI
Дата добавления - 10.10.2018 в 13:31
sboy Дата: Среда, 10.10.2018, 13:36 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 2238
Репутация: 634 ±
Замечаний: 0% ±

Excel 2010
Я просто не понимаю как это работает

Кратко так - вставляете в таблицы оригинальные данные и жмете кнопку "Обновить" ;)
 
Ответить
Сообщение
Я просто не понимаю как это работает

Кратко так - вставляете в таблицы оригинальные данные и жмете кнопку "Обновить" ;)

Автор - sboy
Дата добавления - 10.10.2018 в 13:36
boa Дата: Среда, 10.10.2018, 13:48 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 278
Репутация: 57 ±
Замечаний: 0% ±

2013, 365
AVI,
что-то я не понял как работает

запустить макрос
выбрать диапазон с адресами

и будет создана новая книга с результатом(как во вложении)
К сообщению приложен файл: 3071310.jpg(75.2 Kb) · Rezultat_Macros.xlsb(10.2 Kb)




Сообщение отредактировал boa - Среда, 10.10.2018, 13:50
 
Ответить
СообщениеAVI,
что-то я не понял как работает

запустить макрос
выбрать диапазон с адресами

и будет создана новая книга с результатом(как во вложении)

Автор - boa
Дата добавления - 10.10.2018 в 13:48
AVI Дата: Среда, 10.10.2018, 13:57 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
boa, ДА, запускаю Dictionary_Coll выбираю диапазон R2C13:R4952C13 и открывается пустой лист...
 
Ответить
Сообщениеboa, ДА, запускаю Dictionary_Coll выбираю диапазон R2C13:R4952C13 и открывается пустой лист...

Автор - AVI
Дата добавления - 10.10.2018 в 13:57
SLAVICK Дата: Среда, 10.10.2018, 14:02 | Сообщение № 9
Группа: Модераторы
Ранг: Старожил
Сообщений: 2286
Репутация: 751 ±
Замечаний: 0% ±

2019
идет извлечение фалов" уже 35 минут... и вылезло сообщение

ого а строк сколько?
Вы же к-во квартир не увеличивали?
Имею ввиду таблицу с номерами от 1-400 -- тут нужно сделать до макс. к-ва квартир, но не пихать всю таблицу со всеми квартирами.
Я просто не понимаю как это работает.

да так же как и с моим примером в 2016+ офисе - можно так и так.
По хорошему если данных много есть смысл подумать над запуском через SQL, ну или заточенным макросом, возможно макрос boa, и справится - в алгоритм не вникал.
запустить макрос

Там много макросов. я в таких случаях кнопку ставлю и на него нужный макрос, или другие делать приват, чтобы в списке не светились.


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
идет извлечение фалов" уже 35 минут... и вылезло сообщение

ого а строк сколько?
Вы же к-во квартир не увеличивали?
Имею ввиду таблицу с номерами от 1-400 -- тут нужно сделать до макс. к-ва квартир, но не пихать всю таблицу со всеми квартирами.
Я просто не понимаю как это работает.

да так же как и с моим примером в 2016+ офисе - можно так и так.
По хорошему если данных много есть смысл подумать над запуском через SQL, ну или заточенным макросом, возможно макрос boa, и справится - в алгоритм не вникал.
запустить макрос

Там много макросов. я в таких случаях кнопку ставлю и на него нужный макрос, или другие делать приват, чтобы в списке не светились.

Автор - SLAVICK
Дата добавления - 10.10.2018 в 14:02
AVI Дата: Среда, 10.10.2018, 14:08 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
ого а строк сколько?

700000 помещений
Домов 15000
Таблицу 1-4 увеличил до 1200 - такой номер квартиры максимальный
да так же как и с моим примером в 2016+ офисе - можно так и так.

sboy, Power Query тоже подзавис))

Там много макросов. я в таких случаях кнопку ставлю и на него нужный макрос, или другие делать приват, чтобы в списке не светились.
Я понял первый, который вызывает окошко с выбором диапазона.
 
Ответить
Сообщение
ого а строк сколько?

700000 помещений
Домов 15000
Таблицу 1-4 увеличил до 1200 - такой номер квартиры максимальный
да так же как и с моим примером в 2016+ офисе - можно так и так.

sboy, Power Query тоже подзавис))

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

Автор - AVI
Дата добавления - 10.10.2018 в 14:08
SLAVICK Дата: Среда, 10.10.2018, 14:16 | Сообщение № 11
Группа: Модераторы
Ранг: Старожил
Сообщений: 2286
Репутация: 751 ±
Замечаний: 0% ±

2019
700000 помещений
... 1200

Да уж - выходит таблица на 840млн записей - поэтому и зависает.
Тут или делать кусками(за 10 раз должно потянуть), или макрос. Похоже Алгоритм boa, тоже не оптимальный - я бы сделал по другому.


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
700000 помещений
... 1200

Да уж - выходит таблица на 840млн записей - поэтому и зависает.
Тут или делать кусками(за 10 раз должно потянуть), или макрос. Похоже Алгоритм boa, тоже не оптимальный - я бы сделал по другому.

Автор - SLAVICK
Дата добавления - 10.10.2018 в 14:16
AVI Дата: Среда, 10.10.2018, 14:28 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
я бы сделал по другому

Я бы тоже) только не умею)
 
Ответить
Сообщение
я бы сделал по другому

Я бы тоже) только не умею)

Автор - AVI
Дата добавления - 10.10.2018 в 14:28
boa Дата: Среда, 10.10.2018, 14:29 | Сообщение № 13
Группа: Проверенные
Ранг: Обитатель
Сообщений: 278
Репутация: 57 ±
Замечаний: 0% ±

2013, 365
AVI,
в последнем цикле фор-некст можно добавить строку, что бы выводить только результативные записи
[vba]
Код

        If Len(Dic.Item(a)) = 0 Then Dic.Remove a   'что бы выводить в результат только строки со значениями. Можно закомментировать.
[/vba]
в посте выше подправил,

а вот почему у вас не работает - вопрос

Закомментируйте строку "On Error Resume Next" и запустите макрос, если выдаст ошибку - пишите её сюда, будем разбираться

я бы сделал по другому

я бы посмотрел на альтернативу <_<


 
Ответить
СообщениеAVI,
в последнем цикле фор-некст можно добавить строку, что бы выводить только результативные записи
[vba]
Код

        If Len(Dic.Item(a)) = 0 Then Dic.Remove a   'что бы выводить в результат только строки со значениями. Можно закомментировать.
[/vba]
в посте выше подправил,

а вот почему у вас не работает - вопрос

Закомментируйте строку "On Error Resume Next" и запустите макрос, если выдаст ошибку - пишите её сюда, будем разбираться

я бы сделал по другому

я бы посмотрел на альтернативу <_<

Автор - boa
Дата добавления - 10.10.2018 в 14:29
AVI Дата: Среда, 10.10.2018, 14:32 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
boa, Ругается на [vba]
Код
NewMyArray = Application.Transpose(Array(Dic.keys, Dic.Items))
[/vba]
 
Ответить
Сообщениеboa, Ругается на [vba]
Код
NewMyArray = Application.Transpose(Array(Dic.keys, Dic.Items))
[/vba]

Автор - AVI
Дата добавления - 10.10.2018 в 14:32
boa Дата: Среда, 10.10.2018, 14:56 | Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 278
Репутация: 57 ±
Замечаний: 0% ±

2013, 365
AVI,
а если удалить "Application.Transpose", NewMyArray создастся?


 
Ответить
СообщениеAVI,
а если удалить "Application.Transpose", NewMyArray создастся?

Автор - boa
Дата добавления - 10.10.2018 в 14:56
SLAVICK Дата: Среда, 10.10.2018, 16:13 | Сообщение № 16
Группа: Модераторы
Ранг: Старожил
Сообщений: 2286
Репутация: 751 ±
Замечаний: 0% ±

2019
я бы посмотрел на альтернативу

Как то так:
[vba]
Код
Option Compare Text
Sub d_D()
Dim dic As Object, dic2 As Object, arr, arrT1, arrT2, s$
Dim stKV%, endKV%, i&, ii&, tI&

SORT_

Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")

arr = Selection
i = 2
dic(arr(1, 2)) = arr(1, 2)

Do While i < UBound(arr)
    s = ""
    endKV = 0
    If i > 2 Then dic.RemoveAll
    
    ii = IIf(i > 2, i - 1, 1)
    dic(arr(ii, 2)) = arr(ii, 2)
    Do While arr(i, 1) = arr(i - 1, 1) And i <= UBound(arr)
        dic(arr(i, 2)) = arr(i, 2)
        endKV = IIf(endKV > Val(arr(i, 2)), endKV, Val(arr(i, 2)))
        i = i + 1
        If i > UBound(arr) Then Exit Do
        If i \ 100 = i / 100 Then DoEvents: Application.StatusBar = i
    Loop
        arrT2 = dic.KEYS
        For tI = 1 To endKV ' ЕСЛИ нужно смотреть НЕ с 1-й квартиры, а минимальной - то For tI = arrT2(0)  To endKV
            If Not dic.EXISTS(tI) Then s = s & ", " & tI
        Next
        s = Mid(s, 3, 9 ^ 9)
        dic2(arr(ii, 1)) = s

    i = i + 1
Loop
arr = dic2.KEYS
arrT2 = dic2.ITEMS
ReDim arrT1(1 To UBound(arr) + 1, 1 To 2)
For i = 1 To UBound(arrT1)
   arrT1(i, 1) = arr(i - 1)
   arrT1(i, 2) = arrT2(i - 1)
Next
Sheets.Add
[a1].Resize(UBound(arrT1), 2) = arrT1
Application.StatusBar = False
End Sub

Sub SORT_()
    ActiveSheet.SORT.SortFields.Clear
    ActiveSheet.SORT.SortFields.Add2 _
        Key:=Selection.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveSheet.SORT.SortFields.Add2 _
        Key:=Selection.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveSheet.SORT
        .SetRange Selection
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
[/vba]
К сообщению приложен файл: 53435.xlsm(84.8 Kb)


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

Как то так:
[vba]
Код
Option Compare Text
Sub d_D()
Dim dic As Object, dic2 As Object, arr, arrT1, arrT2, s$
Dim stKV%, endKV%, i&, ii&, tI&

SORT_

Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")

arr = Selection
i = 2
dic(arr(1, 2)) = arr(1, 2)

Do While i < UBound(arr)
    s = ""
    endKV = 0
    If i > 2 Then dic.RemoveAll
    
    ii = IIf(i > 2, i - 1, 1)
    dic(arr(ii, 2)) = arr(ii, 2)
    Do While arr(i, 1) = arr(i - 1, 1) And i <= UBound(arr)
        dic(arr(i, 2)) = arr(i, 2)
        endKV = IIf(endKV > Val(arr(i, 2)), endKV, Val(arr(i, 2)))
        i = i + 1
        If i > UBound(arr) Then Exit Do
        If i \ 100 = i / 100 Then DoEvents: Application.StatusBar = i
    Loop
        arrT2 = dic.KEYS
        For tI = 1 To endKV ' ЕСЛИ нужно смотреть НЕ с 1-й квартиры, а минимальной - то For tI = arrT2(0)  To endKV
            If Not dic.EXISTS(tI) Then s = s & ", " & tI
        Next
        s = Mid(s, 3, 9 ^ 9)
        dic2(arr(ii, 1)) = s

    i = i + 1
Loop
arr = dic2.KEYS
arrT2 = dic2.ITEMS
ReDim arrT1(1 To UBound(arr) + 1, 1 To 2)
For i = 1 To UBound(arrT1)
   arrT1(i, 1) = arr(i - 1)
   arrT1(i, 2) = arrT2(i - 1)
Next
Sheets.Add
[a1].Resize(UBound(arrT1), 2) = arrT1
Application.StatusBar = False
End Sub

Sub SORT_()
    ActiveSheet.SORT.SortFields.Clear
    ActiveSheet.SORT.SortFields.Add2 _
        Key:=Selection.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveSheet.SORT.SortFields.Add2 _
        Key:=Selection.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveSheet.SORT
        .SetRange Selection
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
[/vba]

Автор - SLAVICK
Дата добавления - 10.10.2018 в 16:13
AVI Дата: Среда, 10.10.2018, 16:29 | Сообщение № 17
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
boa, Теперь ругается на [vba]
Код
.Range(.Cells(1, 1), .Cells(Dic.Count, 2)) = NewMyArray
[/vba]
 
Ответить
Сообщениеboa, Теперь ругается на [vba]
Код
.Range(.Cells(1, 1), .Cells(Dic.Count, 2)) = NewMyArray
[/vba]

Автор - AVI
Дата добавления - 10.10.2018 в 16:29
AVI Дата: Среда, 10.10.2018, 16:30 | Сообщение № 18
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
SLAVICK, При открытии сообщает об ошибке части содержимого в книге
Ругается на сортировку. Сам подправлю.

Я правильно понимаю, что для расчета используется только один диапазон, который выделяем?


Сообщение отредактировал AVI - Среда, 10.10.2018, 16:43
 
Ответить
СообщениеSLAVICK, При открытии сообщает об ошибке части содержимого в книге
Ругается на сортировку. Сам подправлю.

Я правильно понимаю, что для расчета используется только один диапазон, который выделяем?

Автор - AVI
Дата добавления - 10.10.2018 в 16:30
boa Дата: Среда, 10.10.2018, 16:41 | Сообщение № 19
Группа: Проверенные
Ранг: Обитатель
Сообщений: 278
Репутация: 57 ±
Замечаний: 0% ±

2013, 365
Теперь ругается на

а массив то создается?
вы его можете посмотреть (shift+F9 , Enter)?


 
Ответить
Сообщение
Теперь ругается на

а массив то создается?
вы его можете посмотреть (shift+F9 , Enter)?

Автор - boa
Дата добавления - 10.10.2018 в 16:41
SLAVICK Дата: Среда, 10.10.2018, 16:45 | Сообщение № 20
Группа: Модераторы
Ранг: Старожил
Сообщений: 2286
Репутация: 751 ±
Замечаний: 0% ±

2019
Я правильно понимаю, что для расчета используется только один диапазон, который выделяем?

да
Процедуру сортировки можно убрать вообще - если там отсортировано по возрастанию квартиры внутри домов.
Макрос делает проход по дому - и если дома вперемешку - будет что попало.


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
Я правильно понимаю, что для расчета используется только один диапазон, который выделяем?

да
Процедуру сортировки можно убрать вообще - если там отсортировано по возрастанию квартиры внутри домов.
Макрос делает проход по дому - и если дома вперемешку - будет что попало.

Автор - SLAVICK
Дата добавления - 10.10.2018 в 16:45
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Отобразить отсутствующие в промежутке номера (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!