Question

在包含数据的工作表中，有一个带有应用过滤器的列，用于限制显示的数据。用户在列中选择一个或多个单元（不一定是连续的）并执行VBA代码。在VBA代码中，我想迭代选定的单元格并对它们进行一些操作，但是当仅选择1个单元格时，Excel行为存在差异（在Excel术语中处于活动状态）。有效的代码：

Sub Macro1()
    If Selection.count = 1 Then
        counter = 1
        Debug.Print Selection.Text
    Else
        counter = Selection.SpecialCells(xlCellTypeVisible).count
        For Each c In Selection.SpecialCells(xlCellTypeVisible)
             Debug.Print c.Text
        Next c
    End If
    Debug.Print counter
End Sub

问题：有没有办法，更优雅和干净的解决方案来做到这一点？摆脱If-Then？

Selection.SpecialCells(xlCellTypeVisible).count

如果只激活了一个单元格，则

会生成溢出错误（我认为Excel将选择范围扩展到整个工作表）

ActiveCell.Select
Selection.SpecialCells(xlCellTypeVisible).count

如果只选择了一个单元格，则

返回2（返回选定的记录两次）

EDIT 请注意：过滤器由用户手动应用，而不是由VBA代码应用。用户还可以从过滤视图中手动选择单元格，然后在VBA代码中使用所选单元格。

Answer 1

以下内容基于此示例数据。

     Column A   Column A   Column C
      a           b           c
1    AA-01       BB-01        1
2    AAA-02      BBB-02       2
3    AAAA-03     BBBB-03      2

这些是我用于AutoFilter Method的方法。处理一个或多个可见行并没有任何问题，也无需区分过滤器集。

Sub filter_test()
    With Worksheets("Sheet16")  '<~~set this properly
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            .AutoFilter field:=3, Criteria1:=1
            'report on column A
            With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    reportVisibleCells visRng:=.Cells
                Else
                    Debug.Print "no visible cells with 1"
                End If
            End With
            .AutoFilter field:=3
            .AutoFilter field:=3, Criteria1:=2
            'report on column B
            With .Resize(.Rows.Count - 1, 1).Offset(1, 1)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    reportVisibleCells visRng:=.Cells
                Else
                    Debug.Print "no visible cells with 2"
                End If
            End With
            .AutoFilter field:=3
            .AutoFilter field:=3, Criteria1:=3
            'report on column C
            With .Resize(.Rows.Count - 1, 1).Offset(1, 2)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    reportVisibleCells visRng:=.Cells
                Else
                    Debug.Print "no visible cells with 3"
                End If
            End With
            .AutoFilter field:=3
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With
End Sub

Sub reportVisibleCells(visRng As Range)
    Dim vr As Range

    With visRng.SpecialCells(xlCellTypeVisible)
        For Each vr In .Cells
            Debug.Print vr.Text
        Next vr
        Debug.Print .Count
    End With
End Sub

设置桌面，以便您可以看到工作表和VBE窗口。打开VBE的立即窗口（Ctrl + G），这样您就可以看到Debug.Print报告。将光标放在filter_test子设备中，然后开始点击F8以完成操作。

VBE立即窗口的预期结果。

AA-01
 1 
BBB-02
BBBB-03
 2 
no visible cells with 3

Answer 2

循环选定单元格并用当前日期填充它们是一件简单的事情询问已经有内容的单元格是否正常。

Sub InsDate()

    Dim r As Range

    d = Date$ ' gibberish
    d = Right(d, 4) + "-" + Mid(d, 4, 2) + "-" + Left(d, 2) ' make ISO'ish

    Set r = Application.Selection 

    For i = 1 To r.Cells.Count
        ans = 1
        If r.Cells(i).Value <> "" Then
            ans = MsgBox("Remove " + r.Cells(i).Text + ", set to " + d, vbOKCancel)
        End If

        If ans = 1 Then
            r.Cells(i).Value = d
        End If
    Next i
End Sub

VBA，Excel - 迭代在筛选列

2 个答案: