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

Question

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

现在，我需要的是过滤例如“F”栏下的实验室，然后使用Outpatient在“D”栏中自动填充所有内容。 接下来再次过滤牙齿在“F”栏下，然后用牙科在“D”栏中自动填充。然后对滤光片的过程相同。

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

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个标准。如上所述，带有Range.SpecialCells method或 xlCellTypeVisible 的xlCellType足以隔离已过滤的行。

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列的值。