Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Адаптировать макрос. Аналог ВПР.
 
Помогите пожалуйста адаптировать макрос уважаемого Hugo. Необходимо с Лист2 перенести на Лист1 данные из столбцов Заявка3, Дата1 и Дата2, сопоставив данные из столбцов Заявка1. Понимание как работает макрос есть, но не хватает знаний по синтаксису для адаптации. Макрос из темы: https://www.planetaexcel.ru/forum/?FID=8&PAGE_NAME=read&TID=31763
Код
Option Explicit

Sub compare()
    Dim a, b, c, iLastrow As Long, i As Long, ii As Long

    '1. данные в два массива
    With Sheet1    'используется кодовое имя
        iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        a = Range(.[a3], .Range("A" & iLastrow)).Value
    End With

    With Sheet2    'используется кодовое имя
        iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        b = Range(.[c2], .Range("A" & iLastrow)).Value
    End With

    '2.пустой массив для результата
    ReDim c(1 To UBound(a), 1 To 2)

    With CreateObject("Scripting.Dictionary")
    
        '3.в словарь уникальные и номер строки из массива
        For i = 1 To UBound(b)
            .Item(b(i, 1)) = i
        Next

        '4.по словарю из массива b в массив c
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then
                c(i, 1) = b(.Item(a(i, 1)), 2)
                c(i, 2) = b(.Item(a(i, 1)), 3)
            End If
        Next
    End With

    '5. выгрузка всего массива
    With Sheet1    'используется кодовое имя
        .[B3].Resize(UBound(c), 2) = c
        .Activate
    End With
End Sub
Изменено: Карабас - 26 фев 2021 11:34:48
 
Без макроса вариант аналога ВПР был в одной из тем.
Изменено: Marat Ta - 26 фев 2021 17:25:53
 
Спасибо, но с организовать через подстановку формулой проблем нет - это все очень медленно. В примере небольшая таблица,в реальности надо обработать таблицу больше 30 тыс. строк и и больше 200 столбцов. И делать это приходится каждый день и не раз.
 
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=35060

Макрос с этой темы. В будущем указывайте предыдущее обсуждение идентичной темы, чтобы не тратить лишнее время на обсуждение.
 
Учту. Макрос  был взят с другой подобной темы: https://www.planetaexcel.ru/forum/?FID=8&PAGE_NAME=read&TID=31763
 
А где в файле примера столбцы Заявка1, Заявка3.
 
Пардон, поправил. Перепутал файлы когда игрался с размером файла для загрузки.
 
Рабочий шаблон. Упрощенный из кода в сообщении 1.
Переносить в ваш файл пример нет времени.
Может кто из форумчан поможет.

Еще один вариант здесь
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=137715&a...
Изменено: Marat Ta - 26 фев 2021 12:52:04
 
Цитата
Marat Ta написал: Переносить в ваш файл пример нет времени.
Спасибо! Адаптировал. Все работает с примером. Попробую "прикрутить" к рабочей таблице.
Может быть еще подскажете как ускорить этот код преобразования текста в дату?
Код
    Cnumb = Rows(1).Find("Контрольная дата", , xlValues, xlWhole).Column
    Range(Cells(2, Cnumb), Cells(NumberLastRow1, Cnumb)).Select
    Selection.NumberFormat = "dd/mm/yy h:mm;@"
    On Error Resume Next
    Set myRange = Intersect(Selection, ActiveSheet.UsedRange)
    For Each cl In myRange
    cl.Value = DateValue(cl.Value)
    cl.Value = cl.Value + 0.333333333
    Next
Изменено: Карабас - 26 фев 2021 14:10:38
 
Прикрепите новый файл пример с макросами.
 
Цитата
Marat Ta написал:
Прикрепите новый файл пример с макросами.
Приложил. Ускорить наверно через обработку в массиве и после запись в диапазон?
Код
    Sub DatVal()

    NumberLastRow1 = Range("a1").CurrentRegion.Rows.Count
    Range(Cells(2, 2), Cells(NumberLastRow1, 2)).Select
    Selection.NumberFormat = "dd/mm/yy h:mm;@"
    On Error Resume Next
    Set myRange = Intersect(Selection, ActiveSheet.UsedRange)
    For Each cl In myRange
    cl.Value = DateValue(cl.Value)
    cl.Value = cl.Value + 0.333333333
    Next
    
    End Sub
Изменено: Карабас - 26 фев 2021 16:18:53
 
Цитата
Карабас: Может быть еще подскажете как ускорить этот код преобразования текста в дату?
а может быть вообще не будем новые темы создавать и все вопросы скидывать сюда, а?
Цитата
Marat Ta: Прикрепите новый файл пример с макросами
вам мало по шапке наприлетало от модераторов? Зачем провоцируете нарушения?
Реквизиты для благодарности и контакты для связи — в профиле
 
Карабас, создавайте новую тему. Отвечу в ней.
 
Карабас, не создавайте!
Marat Taреально начнет в ней отвечать...
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, все ждем помощи только от вас. Долго вас ждали в этой теме. Уже не надеялись.
Изменено: Marat Ta - 26 фев 2021 17:42:46
 
Цитата
Ігор Гончаренко написал:
реально начнет в ней отвечать...
:D
Марат, без обид, хотелось бы увидеть Ваши ответы здесь (на одном или на разных) и здесь (форматирование). Тема без окончательного вывода осталась... Причина в форматировании была или в варианте  версии 2010? Подобные проблемы и у других возникнуть могут, а конкретного ответа (помогло или нет и в чем была причина) в той теме так и нет...
Страницы: 1
Читают тему (гостей: 1)
Наверх