ActiveCell.Offset не работает, когда фильтр активен

Question

Код: -

Sub Macro6()
'
' Macro6 Macro
'
' Keyboard Shortcut: Ctrl+Shift+A
'
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "p"
    Range("C1").Select
    Selection.AutoFilter
    ActiveSheet.Range("A1", Range("C" & Rows.Count).End(xlUp)).AutoFilter Field:=3, Criteria1:="Credit"
    ActiveCell.Offset(1, -1).Select
    'ActiveCell.Offset(1, 0).Select
    'Selection.AutoFilter
End Sub

Это дает следующий результат: -

Но это должно быть " B5"в этом случае.

Преимущественно изменения должны быть сделаны в следующем коде:

    ActiveCell.Offset(1, -1).Select

Answer 1

Автофильтры могут создавать несмежные диапазоны, такие как $C$1:$C$2,$C$6,$C$11,$C$15,$C$19, что означает наличие нескольких областей для работы.

Sub Macro6()

    Dim ws As Worksheet, lastrow As Long
    Dim rngFilter As Range, rng As Variant
    Set ws = ThisWorkbook.ActiveSheet
    ws.Columns("B:B").Insert Shift:=xlToRight

    ws.Range("B1").Value = "p"
    If ws.AutoFilterMode = True Then ws.AutoFilter.ShowAllData

    lastrow = ws.Range("C" & Rows.Count).End(xlUp).Row
    Set rngFilter = ws.Range("A1:C" & lastrow)
    rngFilter.AutoFilter Field:=3, Criteria1:="credit"
    Set rng = Intersect(rngFilter.SpecialCells(xlCellTypeVisible), ws.Columns(3))

    If rng.Areas.Count = 1 Then
        If rng.Cells.Count = 1 Then
            ' no cell to select
            MsgBox "No cell to select", vbCritical
        Else
            rng.Offset(1, -1).Select
        End If
    Else
        If rng.Areas(1).Cells.Count > 1 Then
            rng.Offset(1, -1).Select
        Else
            rng.Areas(2).Offset(0, -1).Select
        End If
    End If

End Sub