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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос поиска, сравнения и постановки значений - Мир MS Excel

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

Excel 2010
Здравствуйте, помогите пожалуйста в написании макроса

Есть фаил на нем 2 листа
Нужно с листа 2 взять В2 (первую ячейку из диапазона В2:В1000) и найти на листе 1 в диапазоне В2:В1500, мы нашли и допустим это В6 на 1 листе,
нужно взять и сравнить С2 со 2 листа с ячейкой С6 на 1 листе, если они равны, сравнить D2 со 2 листа с ячейкой D6 с 1 листа:
- если и они равны то тогда на первом листе в ячейке E6 поставить значение со второго листа из Е2
- если и они не равны то тогда на первом листе в самом низу таблицы заполнить ячейки В1001, С1001, D1001, E1001 значениями со второго листа В2, С2, D2, E2

таким образом нужно проверить весь диапазон В2:В1000 со второго листа

Заранее благодарю.
 
Ответить
СообщениеЗдравствуйте, помогите пожалуйста в написании макроса

Есть фаил на нем 2 листа
Нужно с листа 2 взять В2 (первую ячейку из диапазона В2:В1000) и найти на листе 1 в диапазоне В2:В1500, мы нашли и допустим это В6 на 1 листе,
нужно взять и сравнить С2 со 2 листа с ячейкой С6 на 1 листе, если они равны, сравнить D2 со 2 листа с ячейкой D6 с 1 листа:
- если и они равны то тогда на первом листе в ячейке E6 поставить значение со второго листа из Е2
- если и они не равны то тогда на первом листе в самом низу таблицы заполнить ячейки В1001, С1001, D1001, E1001 значениями со второго листа В2, С2, D2, E2

таким образом нужно проверить весь диапазон В2:В1000 со второго листа

Заранее благодарю.

Автор - boy22
Дата добавления - 18.10.2016 в 18:53
Pelena Дата: Вторник, 18.10.2016, 20:17 | Сообщение № 2
Группа: Модераторы
Ранг: Экселист
Сообщений: 9873
Репутация: 2263 ±
Замечаний: 0% ±

Excel 2010 & Mac Excel 2011
Приложите файл с примером. 1000 строк не надо, достаточно 10


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеПриложите файл с примером. 1000 строк не надо, достаточно 10

Автор - Pelena
Дата добавления - 18.10.2016 в 20:17
boy22 Дата: Вторник, 18.10.2016, 21:06 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
вот пожалуйста
К сообщению приложен файл: 1985782.xlsx(10Kb)
 
Ответить
Сообщениевот пожалуйста

Автор - boy22
Дата добавления - 18.10.2016 в 21:06
Manyasha Дата: Вторник, 18.10.2016, 22:24 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
boy22, здравствуйте. Так подойдет?
[vba]
Код
Sub test()
    Dim sh1 As Worksheet, sh2 As Worksheet, x As Range, dic As Object
    Dim i&, lr&, iKey$
    Set sh1 = ThisWorkbook.Sheets(1)
    Set sh2 = ThisWorkbook.Sheets(2)
    Set dic = CreateObject("scripting.dictionary")
    With sh1
        For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
            iKey = Trim(.Cells(i, "b") & "@" & .Cells(i, "c") & "@" & .Cells(i, "d"))
            dic(iKey) = i
        Next i
    End With
    With sh2
        For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
            iKey = Trim(.Cells(i, "b") & "@" & .Cells(i, "c") & "@" & .Cells(i, "d"))
            If dic.exists(iKey) Then
                sh1.Cells(dic(iKey), "e") = .Cells(i, "e")
            Else
                lr = sh1.Cells(Rows.Count, 2).End(xlUp).Row + 1
                sh1.Cells(lr, "b") = .Cells(i, "b")
                sh1.Cells(lr, "c") = .Cells(i, "c")
                sh1.Cells(lr, "d") = .Cells(i, "d")
                sh1.Cells(lr, "e") = .Cells(i, "e")
            End If
        Next i
    End With
End Sub
[/vba]
К сообщению приложен файл: 1985782-1.xlsm(20Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеboy22, здравствуйте. Так подойдет?
[vba]
Код
Sub test()
    Dim sh1 As Worksheet, sh2 As Worksheet, x As Range, dic As Object
    Dim i&, lr&, iKey$
    Set sh1 = ThisWorkbook.Sheets(1)
    Set sh2 = ThisWorkbook.Sheets(2)
    Set dic = CreateObject("scripting.dictionary")
    With sh1
        For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
            iKey = Trim(.Cells(i, "b") & "@" & .Cells(i, "c") & "@" & .Cells(i, "d"))
            dic(iKey) = i
        Next i
    End With
    With sh2
        For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
            iKey = Trim(.Cells(i, "b") & "@" & .Cells(i, "c") & "@" & .Cells(i, "d"))
            If dic.exists(iKey) Then
                sh1.Cells(dic(iKey), "e") = .Cells(i, "e")
            Else
                lr = sh1.Cells(Rows.Count, 2).End(xlUp).Row + 1
                sh1.Cells(lr, "b") = .Cells(i, "b")
                sh1.Cells(lr, "c") = .Cells(i, "c")
                sh1.Cells(lr, "d") = .Cells(i, "d")
                sh1.Cells(lr, "e") = .Cells(i, "e")
            End If
        Next i
    End With
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 18.10.2016 в 22:24
boy22 Дата: Вторник, 18.10.2016, 22:36 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте, круто hands hands hands , большое спасибо, буду разбираться
 
Ответить
СообщениеЗдравствуйте, круто hands hands hands , большое спасибо, буду разбираться

Автор - boy22
Дата добавления - 18.10.2016 в 22:36
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос поиска, сравнения и постановки значений (Макросы/Sub)
Страница 1 из 11
Поиск:

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