Question

我曾尝试搜索此函数，但是最后却出现了无法运行的科学怪人子例程。我需要：

-将B列过滤为灰色单元格。

-在所有可见行的AB列中，将公式设置为等于B列中的值。如果将某行过滤掉，我需要将其保留为空白。

奖金问题（因为我脖子上很疼）：我还需要做某种循环以在AC：BA列中复制该过程。例如，将C列过滤为灰色单元格，并使AC中所有可见的单元格等于C列中的相应行。

编辑：我还想做一个Control + Find，替换没有背景色的任何单元格，并替换为空白或0。但是，我也无法使用它。

我拥有的代码（目前，我只能选择AB列中的第一个可见单元格）：

Dim Last_Cell As Range
    Set Last_Cell = Range("A3").SpecialCells(xlLastCell)

  ' [Good ]Filter Column B by Color
    Range("$A$3", Last_Cell).AutoFilter Field:=2, Criteria1:=RGB(165,165,_ 
165), Operator:=xlFilterCellColor

    ' [Pending ] Set all visible AB cells = same row in B
    Range("AB3").Offset(1, 0).Activate
    Do Until Selection.EntireRow.Hidden = False
    If Selection.EntireRow.Hidden = True Then
    ActiveCell.Offset(1, 0).Activate
    End If
    Loop

Answer 1

这里有一些代码可供您修改。

下面的子项包含4个参数：整个过滤器列，整个公式列，过滤器标题的行号以及要查找的RGB颜色。

'ASSUMPTION: prngFilterCol is to the left of prngFormulaCol.
Public Sub FilterByColorThenSetFormulas(ByVal prngFilterCol As Excel.Range, ByVal prngFormulaCol As Excel.Range, ByVal plHeaderRow As Long, ByVal plColorRGB As Long)
    Dim rngFirstCellInFilterArea As Excel.Range
    Dim rngLastCellInFilterArea As Excel.Range
    Dim rngFilterTarget As Excel.Range
    Dim rngFormulasTarget As Excel.Range
    Dim rngVisibleCells As Excel.Range
    Dim lColumnsDifference As Long

    'Initialization.
    Set rngFirstCellInFilterArea = prngFilterCol.Cells(plHeaderRow, 1)
    Set rngLastCellInFilterArea = Application.Intersect(rngFirstCellInFilterArea.SpecialCells(xlLastCell).EntireRow, prngFormulaCol)
    lColumnsDifference = prngFilterCol.Column - prngFormulaCol.Column

    'Remove existing filtering.
    prngFilterCol.Worksheet.AutoFilterMode = False

    If rngLastCellInFilterArea.Row > plHeaderRow Then
        Set rngFilterTarget = prngFilterCol.Worksheet.Range(rngFirstCellInFilterArea, rngLastCellInFilterArea)

        'Clear the contents (formulas) in the target column.
        'Our assumption (above) is crucial.
        Set rngFormulasTarget = rngFilterTarget.Columns(rngFilterTarget.Columns.Count)
        rngFormulasTarget.ClearContents

        'Filter.
        rngFilterTarget.AutoFilter Field:=1, Criteria1:=plColorRGB, Operator:=xlFilterCellColor

        'Find the remaining visible cells.
        'Note: SpecialCells will fail if there are no visible cells, hence the On Error Resume Next.
        Set rngVisibleCells = Nothing
        On Error Resume Next
        Set rngVisibleCells = rngFilterTarget.Offset(1).Resize(rngFilterTarget.Rows.Count - 1).SpecialCells(XlCellType.xlCellTypeVisible)
        On Error GoTo 0

        If Not rngVisibleCells Is Nothing Then
            'Assign formulas to the visible cells within prngFormulaCol, using the relative notation of FormulaR1C1.
            rngFormulasTarget.FormulaR1C1 = "=R[0]C[" & CStr(lColumnsDifference) & "]"
        End If
    End If

    'Cleanup.
    prngFilterCol.Worksheet.AutoFilterMode = False
    Set rngFormulasTarget = Nothing
    Set rngVisibleCells = Nothing
    Set rngFilterTarget = Nothing
    Set rngLastCellInFilterArea = Nothing
    Set rngFirstCellInFilterArea = Nothing
End Sub

您可以按以下方式调用它：

Public Sub TestFilterByColorThenSetFormulas()
    Dim lColIndex As Long

    'Example 1.
    'Column 2 is B, column 28 is AB.
    FilterByColorThenSetFormulas Sheet1.Columns(2), Sheet1.Columns(28), 3, RGB(165, 165, 165)

    'Example 2.
    'Loop from column B to Z, putting formulas in columns AB to AZ.
    For lColIndex = 2 To 26
        FilterByColorThenSetFormulas Sheet1.Columns(lColIndex), Sheet1.Columns(lColIndex + 26), 3, RGB(165, 165, 165)
    Next
End Sub

我相信您会找到解决代码的方法。尝试一下，设置一些断点，看看它是如何工作的，并玩得开心。

请注意，该代码使目标工作表未过滤。如果您希望保留过滤器，则可以在以后以编程方式重新建立它们。我将把它留为练习；-）

下面是我的测试工作表的设置：

按颜色过滤行并将公式仅应用于可见行

1 个答案: