Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Заливка ячейки цветом после выполнения макроса
 
#1
15.02.2021 14:18:52
Добрый день, уважаемые пользователи, читатели и гуру замечательной программы.
Написал макрос на выполнение формулы для сбора данных по функции VLOOKUP. Выполняется всё как надо. Но встал вопрос, как сделать так чтобы при не пустом значении ячейки, происходила заливка выбранных ячеек. На данный момент заливка идет всех выбранных ячеек, без результата сбора данных. Пустая она остается или всё же заполняется значением.
Код макроса:
Код
Sub Макрос4()
Application.ScreenUpdating = False
  ActiveCell.FormulaR1C1 = _        "=IFERROR(VLOOKUP(RC[-1],Таблица1,2,0),"""")"
      With Selection.Interior
       .Pattern = xlSolid
       .PatternColorIndex = xlAutomatic
       .Color = 65535
       .TintAndShade = 0
       .PatternTintAndShade = 0 
   End With
   Selection.FillDown
   ActiveSheet.ShowAllData
   Range("G:G").Select
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _       :=False, Transpose:=False
   Application.CutCopyMode = False
   Range("G8").Select
End Sub
Пожалуйста помогите. Если можно то прямо с изменениями данного кода.
Спасибо
Изменено: Tamagafk - 20.02.2021 06:57:20
 
 
 
#2
26.02.2021 11:11:07
Tamagafk, покажите файл пример, а наугад
Код
Sub Макрос4()
Application.ScreenUpdating = True
  ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],Таблица1,2,0),"""")"
  If ActiveCell <> "" Then
      With Selection.Interior
       .Pattern = xlSolid
       .PatternColorIndex = xlAutomatic
       .Color = 65535
       .TintAndShade = 0
       .PatternTintAndShade = 0
   End With
   End If
   Selection.FillDown
   ActiveSheet.ShowAllData
   Range("G:G").Select
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Application.CutCopyMode = False
   Range("G8").Select
End Sub
Изменено: Mershik - 26.02.2021 11:14:44
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
27.02.2021 01:23:28
Mershik, спасибо, но к сожалению нет. Выкладываю пример.
 
 
 
#4
27.02.2021 17:45:03
Tamagafk, ну крутой файл, а описание задачи будет?
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
27.02.2021 18:26:15
так наобум

Код
Sub Макрос4()
Dim LastRow As Long, Rng As Range

    Application.ScreenUpdating = False
    LastRow = Cells(Rows.Count, "H").End(xlUp).Row 'последняя строка в столбце H
    Set Rng = Range("I4:I" & LastRow)
    With Rng
        .Formula = "=IFERROR(VLOOKUP(H4,Таблица1,2,0),"""")"
        .Value = .Value
        .SpecialCells(xlCellTypeConstants, 18).Interior.Color = 65535
    End With
    'если надо снять Автофильтр
    'If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    Range("I2").Select
    Application.ScreenUpdating = True
End Sub
Изменено: New - 27.02.2021 18:26:46
 
 
 
#6
28.02.2021 04:15:06
Mershik, необходимо чтобы происходила заливка выбранных ячеек, и только в тех, в которых результат формулы VLOOKUP не равен пустому значению. На данный момент происходит заливка всех выбранных ячеек, не зависимо осталась ячейка пустой или получила какое-то значение.
 
 
 
#7
28.02.2021 04:17:56
New, добрый день. Пробую применить Ваш код к своему реестру. Ошибок не выдает, но и сбор информации происходит не корректно. К примеру если искомое значение "1", формула не подставляет значение "рыба". Или если искомое значение "5", формула подставляет значение "какао", вместо "масло"
 
 
 
#8
06.03.2021 12:27:42
Хелп! Помогите пожалуйста
 
 
 
Страницы: 1
Наверх