Страницы: 1
RSS
Макрос для подтягивания индексов из кладра (кладр загружен в эту же книгу)
 
Добрый день, коллеги. Пытаюсь сделать выборку почтовых индексов по улице. На листе1 есть улицы, на листе2 есть кусочек КЛАДР, нужно по улицам подтянуть индекс. Проблема в том, что данных из кладр около 1,5 млн строчек. И хотят чтобы они лежали именно в книге екселя. Понимаю что формулами там ничего не сделаешь. Нужен макрос, причем который будет оптимальный для такого объема. Суть такая если находятся в кладре 2 и более одинаковых улицы, то ничего не писать, если таких улиц нет, то тоже ничего не писать. Если находится одна улица, то тогда подтягивать индекс на первый лист. С акцессом не хотят замарачиваться.
Заранее спасибо всем кто откликнется. Файл прилагаю.  
 
если у вас полтора мильена строк, то на листе уже не поместится, пусть на двух(трех) листах..
индексируем масив по улицам по трем первым буквам - заносим в словарь. словарь с ключами из первых 3хбукв будет содержать вложенные словари, ключами которых будут полные названия, а содержанием  индексы.(если встречаются повторения, то словарь при добавлении выдаст ошибку, отловив  кот, удаляем этот элемент)
работать будет быстро, только при загрузке немного тормознет при создании словаря, а дальше все полетит..
Живи и дай жить..
 
А насколько велик будет диапазон с улицами на первом листе?
 
Юрий М максимум 500 улиц.
Я вот сейчас думаю попробовать записать в ВБА  СЧЕТЕСЛИ, и если он больше 1 то писать в ВБА ВПР иначе пусто оставлять. Как думаете так сойдет или будет тормозить.
Слэн там чуть меньше полутора мульена, на листе как раз помещается. Словарь с ключами что то не особо представляю как. Можете показать пример кода, чтобы понимать куда двигаться.
 
Пример не очень удачный: нет совпадений улиц))
См. мой вариант (выполнить при активном первом листе):
Код
Sub Macro1()
Dim LastRow As Long, i As Long, RngMain As Range, Rng As Range, Arr()
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Arr = Range(Cells(2, 1), Cells(LastRow, 2)).Value
    With Sheets("Лист2")
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Set RngMain = Range(.Cells(2, 1), .Cells(LastRow, 3))
        For i = 1 To UBound(Arr)
            If Application.WorksheetFunction.CountIf(RngMain, Arr(i, 1)) = 1 Then
                Set Rng = .Columns(1).Find(what:=Arr(i, 1), LookIn:=xlValues, lookAt:=xlWhole)
                If Not Rng Is Nothing Then Arr(i, 2) = Rng.Offset(0, 2)
            End If
        Next
    End With
    [A2].Resize(UBound(Arr, 1), 2).Value = Arr
End Sub
 
Цитата
alexthegreat написал:
в ВБА  СЧЕТЕСЛИ, и если он больше 1
По условию задачи нужно если РАВНО 1  
 
alexthegreat, можно расположить базу на одном листе в нескольких группах столбцов. В этом файле часть данных в A:C, другая часть в F:H. Формула
Код
=ЕСЛИ(СЧЁТЕСЛИ(Лист2!A:A;A2)+СЧЁТЕСЛИ(Лист2!F:F;A2)<>1;"";ЕСЛИОШИБКА(ВПР(A2;Лист2!A:C;3;);"")&ЕСЛИОШИБКА(ВПР(A2;Лист2!F:H;3;);""))
 
Юрий М верно, если равно 1. То есть если в кладре две такие улицы или более, то ничего не выводим. Запустил макрос. Работает странно, выводит только первые два значения в остальных ячейках пусто. При чем Верхние Поля в кладре 4 таких улицы, он все ровно выводит.
Юрий М ИЗВИНЯЮСЬ, он ничего не выводит, похоже все правильно. Сейчас еще протестирую.  
Изменено: alexthegreat - 29.06.2015 11:09:28
 
Может что-то с написанием? Как в примере с Каширское - впереди есть пробел. И ещё раз:
Цитата
Юрий М написал: Пример не очень удачный: нет совпадений улиц
Неужели нельзя было немного поработать с примером?
 
Юрий М Написал улицу, которой нет в кладре, она точно одна, все ровно оставляет пустыми ячейки.
Казанский формулы наверное повесят Ексель.  
Изменено: alexthegreat - 29.06.2015 11:13:10
 
Цитата
alexthegreat написал: Написал улицу, которой нет в кладре
И что? Так и должно быть, исходя из первоначальной постановки задачи:
Цитата
alexthegreat написал: если таких улиц нет, то тоже ничего не писать
 
Цитата
alexthegreat написал: Написал улицу, которой нет в кладре, она точно одна, все ровно оставляет пустыми ячейки.
Интересно - а что должно быть в ячейке, если такой улицы в КЛАДРе нет? )) Что подтягивать?
 
Юрий М Улицу написал в КЛАДР (придумал). ОНа точно одна там, и эту же улицу скопировал на лист1. Она не подтягивается. Разбираюсь с кодом.
Изменено: alexthegreat - 29.06.2015 11:26:24
 
А я сделал наоборот: улицу из КЛАДРа скопировал на первый лист - находит.
 
вот, примерно
Живи и дай жить..
 
Слэн к сожалению даже в примере не заполняет улицы. Написал улицы в базе и на листе где должен выводить. Не выводит. Пример прилагаю на всякий случай (если будет интересно). Может быть я что то не правильно делаю.
Пока что пример который предложил Казанский подходит больше всего, но не знаю как он будет работать с таким объемом данных, сейчас пытаюсь тестировать.
Изменено: alexthegreat - 29.06.2015 12:30:36
 
Странно это... Посмотрите мой файл с макросом. Жёлтым отметил две позиции, которые я скопировал из КЛАДРа
 
да, исправил
Живи и дай жить..
 
Слэн Если внести так же другие названия, не подтягивает.
Юрий М Спасибо большое. Вроде то что надо, буду тестировать. Еще раз огромное спасибо, очень помогли.
 
что значит внести?
вы код смотрели?
я же писАл - обновляется словарь только при загрузке книги. если вы открыли и внесли, то нужно или сохранить и выйти или вручную запустить workbook_open
приделайте кнопочку для запуска вручную, наконец..
если же вам нужно сделать под ключ, то надо перенести тему в ветку работа
Живи и дай жить..
 
Слэн спасибо, разобрался.
 
find и счетесли - это очень долго, тем более два раза перебор на каждом шаге

это я по макросу Юрия
Изменено: Слэн - 29.06.2015 13:25:42
Живи и дай жить..
 
Цитата
Слэн написал:
два раза перебор на каждом шаге
На каждом шаге? А второй раз где? )
 
Код
For i = 1 To UBound(Arr)
            If Application.WorksheetFunction.CountIf(RngMain, Arr(i, 1)) = 1 Then ' первый раз
                 Set Rng = .Columns(1).Find(what:=Arr(i, 1), LookIn:=xlValues, lookAt:=xlWhole)' второй
                 If Not Rng Is Nothing Then Arr(i, 2) = Rng.Offset(0, 2)
            End If
        Next

счетесли перебирает весь массив из мильена строк
find тоже перебирает, пусть и не всегда весь массив, но вплоть до этого..
Изменено: Слэн - 29.06.2015 13:47:21
Живи и дай жить..
 
Слэн, я понимаю, что Find - это тоже некий цикл, который мы не видим, но у меня на КАЖДОМ шаге внешнего цикла происходит ОДИН перебор этим "невидимым" циклом) Где второй?
 
Вроде понял - про CountIf разговор? )
 
да, я уже написАл выше
Живи и дай жить..
Страницы: 1
Читают тему
Наверх