应用过滤器然后通过宏修改不同的列

Question

参考下表，在“F”列下有一个过滤器，包含以下选项： 实验室、牙科、光学

现在，我需要在“F”列下过滤例如实验室，然后在“D”列中使用门诊病人自动填充所有内容。 接下来是在“F”列下再次过滤牙科，然后使用牙科在“D”列中自动填充所有内容。然后对滤光片进行同样的处理。

我尝试录制宏，结果如下：

Sub test()

    ActiveSheet.Range("$A$1:$S$2252").AutoFilter Field:=6, Criteria1:="Dental"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "Dental"
    Selection.FillDown
    ActiveSheet.Range("$A$1:$S$2252").AutoFilter Field:=6, Criteria1:="Optical"
    Range("D42").Select
    ActiveCell.FormulaR1C1 = "Optical"
    Range("D42").Select
    Selection.FillDown
    ActiveSheet.Range("$A$1:$S$2252").AutoFilter Field:=6

End Sub

但是，我不能使用此记录，因为我的某些工作表具有不同的值，例如在单元格“D3”中有时与上例不同。

提前感谢您在这方面帮助我。

Answer 1

您可以遍历一组值并一次提供一个 Range.AutoFilter Method 标准。如前所述，带有xlCellType 或xlCellTypeVisible 的Range.SpecialCells method 足以隔离过滤的行。

Sub meddenlab()
    Dim a as long, arr As Variant

    arr = Array("Laboratory", "Dental", "Optical")

    With Worksheets("Sheet1")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            For a = LBound(arr) To UBound(arr)
                .AutoFilter field:=6, Criteria1:=arr(a)
                'step down one row off the header
                With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                    'first check to see if there are visible cells
                    If CBool(Application.Subtotal(103, .Cells)) Then
                        'there are visible rows - apply the ben typ
                        .Columns(4).SpecialCells(xlCellTypeVisible) = arr(a)
                    End If
                End With
                .AutoFilter
            Next a
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

End Sub

如果 D 列中的福利类型与 F 列中的福利类型不匹配，则可以使用两个大小相等的数组。使用第一个作为 F 列的标准，第二个作为 D 列的值。