复制没有填充条件格式列的单元格答案

【问题标题】：Copy Cells With No Fill in Conditionally Formatted Column复制没有填充条件格式列的单元格
【发布时间】：2021-03-03 03:56:41
【问题描述】：

我正在尝试创建一个 VBA 宏，用于搜索条件格式列中的填充单元格，并仅选择包含数据但未被条件格式填充为红色的单元格（无填充颜色）。

然后，一旦选择了没有填充的单元格，我想将它们复制到不同列的底部。我一直在选择我范围内未填充的单元格。

    Sub PM2_COPY()

    Sheets("M&C").Select
    range("A2").Select
    range(selection, selection.End(xlDown)).Select
    selection.COPY
    Sheets("SUMMARY").Select
    range("U7").Select
    selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    range("U6").Select
    Application.CutCopyMode = False
    selection.AutoFilter
    ActiveWorkbook.Worksheets("SUMMARY").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SUMMARY").AutoFilter.Sort.SortFields.Add(range( _
        "U6"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
        = RGB(255, 199, 206)
    With ActiveWorkbook.Worksheets("SUMMARY").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    range("U7").Select
    range.AutoFilter (cell.Interior.ColorIndex = xlNone)
    For Each cell In range.AutoFilter(cell.Interior.ColorIndex = xlNone)
    cell.Select
    selection.COPY
    Sheets("SUMMARY").Select
    range("A7").End(xlDown).Offset(1, 0).Select
    selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    End If
    Next
End Sub

【问题讨论】：

使用Range.AutoFilter并按颜色过滤。
如果要循环，则需要对条件格式的单元格使用cell.DisplayFormat.Interior.ColorIndex。
我在代码前面应用了一个过滤器将它们排序到底部，你指的是这个吗？我不确定 range.autofilter 功能如何帮助我。当我把它放到我的代码中时，它给了我一个“参数不是可选错误”。
如果您已经在使用过滤器，那么只需按颜色过滤，而不是排序。我指的是Range.AutoFilter method... 你必须添加参数。您可以筛选出没有颜色的单元格，然后您可以复制可见的单元格。

标签： excel vba conditional-formatting

【解决方案1】：

使用Range.AutoFilter 并指定没有颜色的单元格，然后复制可见单元格。类似于以下内容：

With ActiveWorkbook.Worksheets("SUMMARY")
    Dim lastRow As Long
    lastRow = .Cells(.Rows.Count, "U").End(xlUp).Row

    .Range("U6:U" & lastRow).AutoFilter Field:=1, Operator:= _
        xlFilterNoFill

    On Error Resume Next
    Dim visibleCells As Range
    Set visibleCells = .Range("U7:U" & lastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    .ShowAllData ' Clear filter

    If Not visibleCells Is Nothing Then
        visibleCells.Copy
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues

        Application.CutCopyMode = False
    End If
End With

【讨论】：

lastRow = .Cells(.Row.Count, "U").End(xlUp).Row 突出显示给我一个错误，指出“对象不支持此属性或方法”跨度>
.Rows.Count，你打错了。