Фильтровать строки по цвету и применять формулы только к видимым строкам

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

Надеюсь, вы найдете способ обойти код. Попробуйте, установите несколько контрольных точек, посмотрите, как это работает, и повеселитесь.

Обратите внимание, что код оставляет целевой лист нефильтрованным. Если вы хотите, чтобы фильтры оставались, вы можете восстановить их впоследствии, программно. Я оставлю это как упражнение; -)

Ниже приведены настройки моей тестовой таблицы: