Страницы: 1
RSS
Подсветка текста дубликатов, по значению из одной ячейки. VBA
 
Здравствуйте, помогите решить задачу средствами VBA. При вводе значения в ячейку E2, значения в диапазоне C7:E должны выделяться красным цветом.
В примере есть макрос, который выполняет поиск дубликатов по значению из E2, а точнее, протягивает формулу в диапазоне A7:A, которая осуществляет поиск в диапазоне C7:E. Возможно его нужно доработать.
Код
Sub Fill()
Application.ScreenUpdating = False
If [E2] <> 0 Then
Dim SRow&
Dim SRowD&
Dim SRowE&
SRow = Cells(Rows.Count, 3).End(xlUp).Row
SRowD = Cells(Rows.Count, 4).End(xlUp).Row
SRowE = Cells(Rows.Count, 5).End(xlUp).Row
If SRow < SRowD Then SRow = SRowD
If SRow < SRowE Then SRow = SRowE
Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)).ClearContents
SRow = IIf(SRow < 7, 7, SRow)
 If SRow > 7 Then
    Range("A7").FormulaArray = "=--ISNA(MATCH(999,SEARCH(R2C5,RC[2]:RC[4]),1))"
    Range("A7").Copy: Range("A8:A" & SRow).PasteSpecial Paste:=xlPasteFormulas
 End If
    Application.CutCopyMode = False
    [E2].Select
Else
    Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)).ClearContents
End If
    Application.ScreenUpdating = True
End Sub
Изменено: Hashtag - 15.03.2019 12:12:26
 
В модуль листа
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E2")) Is Nothing And Target.Count = 1 Then
    Dim iRng As Range, iAddr$
    With Range("C7:E" & Me.UsedRange.Rows.Count)
    Set iRng = .Find(Target.Value, LookIn:=xlValues)
    If Not iRng Is Nothing Then
        iAddr = iRng.Address
        Do
            iRng.Font.ColorIndex = 3
            Set iRng = .FindNext(iRng)
        Loop While Not iRng Is Nothing And iRng.Address <> iAddr
    End If
    End With
End If
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Sanja

Спасибо, как снять выделение красным после удаления значения из E2?
 
Код
With Range("C7:E" & Me.UsedRange.Rows.Count)
    .ClearFormats
' далее по тексту
Согласие есть продукт при полном непротивлении сторон
 
Sanja
Все работает, спасибо вам огромное!
Страницы: 1
Наверх