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