В столбцах Bk и CB они оба содержат формулы, результатом которых будет код. Теперь CB также будет содержать четыре кода и оператор удаления, который, если они совпадают с ячейкой в столбце BK в той же строке, возьмет значение из CB и вставит его, таким образом переопределив значение в BK с этим кодом, а затем вставьте его красным.
вышеупомянутое должно выполняться только в отфильтрованном диапазоне.
Игнорировать # N / A есть, так как столбец overide будет ошибаться почти в каждой строке, за исключением случаев, когда есть код для overide.
Этот макрос отлично работает без оператора visible cells в конце строки my with range, но как только добавляется оператор visible cells, l oop поднимается только до # N / A и игнорирует остальная часть оператора ElseIF.
Вот мой код ниже:
Option Explicit
Sub Override()
Dim x As Workbook: Set x = ThisWorkbook
Dim rRange As Variant, fltrdRng As Range, aCell As Range, rngToCopy As Range
Dim ws As Worksheet
Dim LR As Long
Dim LR2 As Long
Dim SrchRng As Range, cel As Range
Dim mRow
mRow = 2
Set ws = x.Worksheets("Data")
LR = ws.Range("CB" & ws.Rows.Count).End(xlUp).Row
LR2 = ws.Range("BK" & ws.Rows.Count).End(xlUp).Row
'clears any filters on the sheet
ws.AutoFilterMode = False
' turns formula's to manual
Application.Calculation = xlManual
'copies down the formula in Column BK ignoring the last two rows as they have already been pasted over.
ws.Range("BK2:BK4 ").AutoFill Destination:=ws.Range("BK2:BK" & LR2 - 2)
'filters on N/A's and 10 as these are the codes we are interested in overiding
ws.Range("$A$1:$CB$1").AutoFilter Field:=19, Criteria1:=Array( _
"10", "N/A"), Operator:= _
xlFilterValues
' will loop through all cells in specified range and ignore any error's and #N/A's and will paste over the code overided in CB column to the BK column if conditions are met.
On Error Resume Next
While IsEmpty(ws.Range("CB" & mRow)) = False
With ws.Range("CB" & mRow).SpecialCells(xlCellTypeVisible)
If .Value = "#N/A" Then
ElseIf .Value = "1234" Then
.Offset(0, -17).Value = "1234"
.Offset(0, -17).Interior.Color = vbRed
ElseIf .Value = "1235" Then
.Offset(0, -17).Value = "1235"
.Offset(0, -17).Interior.Color = vbRed
ElseIf .Value = "1236" Then
.Offset(0, -17).Value = "1236"
.Offset(0, -17).Interior.Color = vbRed
ElseIf .Value = "Remove" Then
.Offset(0, -17).Value = "Remove"
.Offset(0, -17).Interior.Color = vbRed
ElseIf .Value = "1237" Then
.Offset(0, -17).Value = "1237"
.Offset(0, -17).Interior.Color = vbRed
End If
End With
mRow = mRow + 1
Wend
'turn Formula 's back to automatic
Application.Calculation = xlAutomatic
End Sub