Добрый день. Прошу помочь в решении задачи приведенной ниже: Имеется вкладка со списком ФИО «Черный список», а также вкладка с Клиентами юр.лицами у которых есть представители (ген. дир, глав бух и проч. лица) При поиске представителей и совпадении по черному списку необходимо вывести сообщение (любое информационное). Т.к. база достаточна велика то условное форматирование визуально помогает, но не достаточно, поэтому при совпадении дополнительно должно выводиться сообщение. Используя функ с IfEmpty не работает, т.к забита формула (ВПР – поиск совпадений по ФИО). Идеально было бы «своять» макрос чтобы в сообщении указывалось наименование Клиента (+ФИО представителя). По всем совпадениям. Файл во вложении.
Добрый день. Прошу помочь в решении задачи приведенной ниже: Имеется вкладка со списком ФИО «Черный список», а также вкладка с Клиентами юр.лицами у которых есть представители (ген. дир, глав бух и проч. лица) При поиске представителей и совпадении по черному списку необходимо вывести сообщение (любое информационное). Т.к. база достаточна велика то условное форматирование визуально помогает, но не достаточно, поэтому при совпадении дополнительно должно выводиться сообщение. Используя функ с IfEmpty не работает, т.к забита формула (ВПР – поиск совпадений по ФИО). Идеально было бы «своять» макрос чтобы в сообщении указывалось наименование Клиента (+ФИО представителя). По всем совпадениям. Файл во вложении.Piston
Как я понял задачу (вдруг угадал) Кнопка "Проверка" [vba]
Код
Sub Макрос1() txt = "См. ЧерныйСписок" & vbCrLf ilr = Cells(Rows.Count, 1).End(xlUp).Row For ic = 3 To 7 Step 2 For ir = 1 To ilr If Cells(ir, ic).Value <> "" Then txt = txt & Cells(ir, 1).Value & " " & Cells(ir, ic).Value & vbCrLf End If Next ir Next ic MsgBox txt, 48, "ВНИМАНИЕ!!!" End Sub
[/vba]
Как я понял задачу (вдруг угадал) Кнопка "Проверка" [vba]
Код
Sub Макрос1() txt = "См. ЧерныйСписок" & vbCrLf ilr = Cells(Rows.Count, 1).End(xlUp).Row For ic = 3 To 7 Step 2 For ir = 1 To ilr If Cells(ir, ic).Value <> "" Then txt = txt & Cells(ir, 1).Value & " " & Cells(ir, ic).Value & vbCrLf End If Next ir Next ic MsgBox txt, 48, "ВНИМАНИЕ!!!" End Sub
ммм, чуть поторопился. Если совпадений НЕ найдено, то как вывести сообщение что все ОК, например фразу "Проверка завершена успешно, совпадений не найдено"
ммм, чуть поторопился. Если совпадений НЕ найдено, то как вывести сообщение что все ОК, например фразу "Проверка завершена успешно, совпадений не найдено"Piston
Sub Макрос1() check = False txt = "См. ЧерныйСписок" & vbCrLf ilr = Cells(Rows.Count, 1).End(xlUp).Row For ic = 3 To 7 Step 2 For ir = 1 To ilr If Cells(ir, ic).Value <> "" Then check = True txt = txt & Cells(ir, 1).Value & " " & Cells(ir, ic).Value & vbCrLf End If Next ir Next ic If check Then MsgBox txt, 48, "ВНИМАНИЕ!!!" Else MsgBox "Все ОК" End If End Sub
[/vba]
Добавьте доп проверку [vba]
Код
Sub Макрос1() check = False txt = "См. ЧерныйСписок" & vbCrLf ilr = Cells(Rows.Count, 1).End(xlUp).Row For ic = 3 To 7 Step 2 For ir = 1 To ilr If Cells(ir, ic).Value <> "" Then check = True txt = txt & Cells(ir, 1).Value & " " & Cells(ir, ic).Value & vbCrLf End If Next ir Next ic If check Then MsgBox txt, 48, "ВНИМАНИЕ!!!" Else MsgBox "Все ОК" End If End Sub