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

Вход

Регистрация

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

 

= Мир MS Excel/формула ВПР через макрос - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » формула ВПР через макрос (Макросы/Sub)
формула ВПР через макрос
shady12 Дата: Воскресенье, 03.12.2017, 21:19 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте.
Необходимо сопоставить данные, которые находятся на разных листах при помощи макроса. данный макрос сопоставляет и выводит данные по конкретно 2м столбцам. Как нужно его переписать, если кол-во столбцов в листе2 неизвестно?
К сообщению приложен файл: _2_H.xls(68Kb)
 
Ответить
СообщениеЗдравствуйте.
Необходимо сопоставить данные, которые находятся на разных листах при помощи макроса. данный макрос сопоставляет и выводит данные по конкретно 2м столбцам. Как нужно его переписать, если кол-во столбцов в листе2 неизвестно?

Автор - shady12
Дата добавления - 03.12.2017 в 21:19
Manyasha Дата: Воскресенье, 03.12.2017, 21:37 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2028
Репутация: 843 ±
Замечаний: 0% ±

Excel 2010, 2016
shady12, здравствуйте, так хотите?
[vba]
Код
Option Explicit
Sub compare()
    Dim a, b, c, iLastrow As Long, iLastcol As Long, i As Long, ii As Long, j 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
        iLastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
        b = .[a2].Resize(iLastrow - 1, iLastcol).Value
    End With

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

    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
                For j = 2 To UBound(b, 2)
                    c(i, j - 1) = b(.Item(a(i, 1)), j)
                Next j
            End If
        Next
    End With

    '5. выгрузка всего массива
    With Sheet1    'используется кодовое имя
        .[B3].Resize(UBound(c), UBound(b, 2) - 1) = c
        .Activate
    End With

End Sub
[/vba]
К сообщению приложен файл: _2_H-1.xls(70Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеshady12, здравствуйте, так хотите?
[vba]
Код
Option Explicit
Sub compare()
    Dim a, b, c, iLastrow As Long, iLastcol As Long, i As Long, ii As Long, j 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
        iLastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
        b = .[a2].Resize(iLastrow - 1, iLastcol).Value
    End With

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

    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
                For j = 2 To UBound(b, 2)
                    c(i, j - 1) = b(.Item(a(i, 1)), j)
                Next j
            End If
        Next
    End With

    '5. выгрузка всего массива
    With Sheet1    'используется кодовое имя
        .[B3].Resize(UBound(c), UBound(b, 2) - 1) = c
        .Activate
    End With

End Sub
[/vba]

Автор - Manyasha
Дата добавления - 03.12.2017 в 21:37
shady12 Дата: Воскресенье, 03.12.2017, 21:47 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Manyasha, идеально! Спасибо Вам огромное, очень помогли hands
 
Ответить
СообщениеManyasha, идеально! Спасибо Вам огромное, очень помогли hands

Автор - shady12
Дата добавления - 03.12.2017 в 21:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » формула ВПР через макрос (Макросы/Sub)
Страница 1 из 11
Поиск:

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