Примечание к ячейке с подстановкой данных с неск. листов

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Примечание к ячейке с подстановкой данных с неск. листов (Формулы/Formulas)

xyz

Дата: Пятница, 10.02.2017, 11:09 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2003

Здравствуйте.
Помогите пожалуйста с такой задачей
В книге несколько листов, на листах есть по 2 столбца, надо сравнить ячейки из 1-го столбца каждого листа с первым столбцом листа на котором запущен макрос,
при совпадении значений, добавить примечание (комментарий) в виде значения ячейки из вторых столбцов с каждого листа, ко второму столбцу листа, с которого запущен макрос
Если значения из 1-го столбца совпадают на нескольких листах в т.ч. на листе с макросом, то комментарий становится многострочным
В приложении пример с макросом добавляющим примечания на 3-ий лист с соседних листов, но там строки подряд, а хотелось бы с подстановкой, возможно ли такое реализовать?

К сообщению приложен файл: comments_podsta.xls (44.5 Kb)

Сообщение отредактировал xyz - Пятница, 10.02.2017, 11:32

Ответить

sboy

Дата: Пятница, 10.02.2017, 11:56 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566

Репутация: 724 ±

Замечаний: 0% ±

Excel 2010

Добрый день.
Если правильно понял
[vba]

Код

Sub comm()
Dim iLastRow As Long
On Error Resume Next
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 11 To iLastRow
txt1 = ""
txt2 = ""
If Not IsEmpty(Cells(i, 4)) Then
txt1 = WorksheetFunction.VLookup(Cells(i, 1), Sheets(1).Range("A:D"), 4, False)
txt2 = WorksheetFunction.VLookup(Cells(i, 1), Sheets(2).Range("A:D"), 4, False)
Worksheets(3).Cells(i, 4).Comment.Delete
Worksheets(3).Cells(i, 4).AddComment.Text ActiveWorkbook.Sheets(1).Name & " : " _
& txt1 & vbNewLine & ActiveWorkbook.Sheets(2).Name & " : " & txt2
End If
Next
End Sub

[/vba]