в Excel VBA, почему мой код не работает с видимым типом SpecialCells и работает без него? - PullRequest
0 голосов
/ 06 августа 2020

В столбцах 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

1 Ответ

0 голосов
/ 06 августа 2020

With ws.Range("CB" & mRow).SpecialCells(xlCellTypeVisible)

Использование SpecialCells только для одной ячейки - это проблематично c.

Вместо этого используйте его на весь отфильтрованный столбец, например этот, который заменит весь ваш While...Wend l oop (кстати, While...Wend устарел):

On Error Resume Next
Dim visibleCells As Range
Set visibleCells = ws.Range("CB2:CB" & LR).SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If visibleCells Is Nothing Then Exit Sub

Dim cell As Range
For Each cell In visibleCells
    If Not IsError(cell.Value) Then
        Select Case cell.Value
            Case "1234", "1235", "1236", "1237", "Remove"
                cell.Offset(0, -17).Value = cell.Value
                cell.Offset(0, -17).Interior.Color = vbRed
        End Select
    End If
Next
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...