Здравствуйте! Прошу извинить заранее, т.к. новичок в создании макросов, да и в VBA тоже. Хотелось бы узнать как можно создать макрос по следующему алгоритму: активная ячейка из столбца А лист1 сравнивается с таблицей на листе 3 столбец А и при совпадении вывод информационное окно с содержимым столбца В листа 3( соответствующей строки). Прошу не кидаться тапками.
Здравствуйте! Прошу извинить заранее, т.к. новичок в создании макросов, да и в VBA тоже. Хотелось бы узнать как можно создать макрос по следующему алгоритму: активная ячейка из столбца А лист1 сравнивается с таблицей на листе 3 столбец А и при совпадении вывод информационное окно с содержимым столбца В листа 3( соответствующей строки). Прошу не кидаться тапками.andre131313
Так нужно? Сделал не для выделенной ячейки, а для всех сразу в столбце А [vba]
Код
Sub tt() n_ = Cells(Rows.Count, 1).End(3).Row - 1 'кол нужных ячеек в столбце А If n_ = 0 Then Exit Sub 'если там только шапка - выход из макроса With Sheets("Лист3") 'Для листа Лист3 n1_ = .Cells(.Rows.Count, 1).End(3).Row - 1 'кол нужных ячеек в столбце А If n1_ = 0 Then Exit Sub 'если там только шапка - выход из макроса ar1 = .Range("A2").Resize(n1_, 2) 'данные столбцов АВ - в массив End With 'окончание работы с листом Лист3 ar = Range("A2").Resize(n_) 'данные столбца А в массив Range("A2").Resize(n_).ClearComments 'в столбце А удаляем все комментарии Set slov = CreateObject("Scripting.Dictionary") 'объявление словаря With slov 'для него For i = 1 To n1_ 'цикл по массиву ar1 .Item(ar1(i, 1)) = ar1(i, 2) 'заносим в словарь. Ключи - из столбца А, элементы - из столбца В Next i For i = 1 To n_ 'цикл по массиву ar If .Exists(ar(i, 1)) Then 'если i-я запись в массиве есть в словаре If .Item(ar(i, 1)) <> "" Then 'если соответствующий элемент в слоываре не пустой Cells(i + 1, 1).AddComment 'в ячейку столбца А строки i+1 добавляем примечание Cells(i + 1, 1).Comment.Text Text:=.Item(ar(i, 1)) 'заполняем его значением элемента словаря End If End If Next i End With End Sub
[/vba] * Добавил комментарии
Так нужно? Сделал не для выделенной ячейки, а для всех сразу в столбце А [vba]
Код
Sub tt() n_ = Cells(Rows.Count, 1).End(3).Row - 1 'кол нужных ячеек в столбце А If n_ = 0 Then Exit Sub 'если там только шапка - выход из макроса With Sheets("Лист3") 'Для листа Лист3 n1_ = .Cells(.Rows.Count, 1).End(3).Row - 1 'кол нужных ячеек в столбце А If n1_ = 0 Then Exit Sub 'если там только шапка - выход из макроса ar1 = .Range("A2").Resize(n1_, 2) 'данные столбцов АВ - в массив End With 'окончание работы с листом Лист3 ar = Range("A2").Resize(n_) 'данные столбца А в массив Range("A2").Resize(n_).ClearComments 'в столбце А удаляем все комментарии Set slov = CreateObject("Scripting.Dictionary") 'объявление словаря With slov 'для него For i = 1 To n1_ 'цикл по массиву ar1 .Item(ar1(i, 1)) = ar1(i, 2) 'заносим в словарь. Ключи - из столбца А, элементы - из столбца В Next i For i = 1 To n_ 'цикл по массиву ar If .Exists(ar(i, 1)) Then 'если i-я запись в массиве есть в словаре If .Item(ar(i, 1)) <> "" Then 'если соответствующий элемент в слоываре не пустой Cells(i + 1, 1).AddComment 'в ячейку столбца А строки i+1 добавляем примечание Cells(i + 1, 1).Comment.Text Text:=.Item(ar(i, 1)) 'заполняем его значением элемента словаря End If End If Next i End With End Sub