Excel:隐藏未彩色的细胞



我有一个脚本,可以更改单元格一个脚本,以隐藏未彩色的单元格。隐藏脚本有效,但它隐藏了所有,甚至是彩色的单元格。我注意到,当我使用更改单元格颜色的脚本时,不会检测Excel接口中的更改(在" HOME"中的"填充颜色"选项卡中,在'font size下'选择)。我还注意到,当尝试更改使用脚本颜色的单元格的颜色(使用Excel接口)时,它不会更改(颜色似乎已固定在脚本中设置的任何内容)。

因此,似乎该接口未检测到使用着色脚本进行的更改。

另外,我注意到下面的脚本需要一段时间来检查/隐藏所有单元格。如果有一种方法可以加快流程,那将是很棒的!

任何帮助将不胜感激!

谢谢!

隐藏未颜色的单元格的脚本:

Public Sub HideUncoloredRows()
Dim startColumn As Integer
Dim startRow As Integer
Dim totalRows As Integer
Dim totalColumns As Integer
Dim currentColumn As Integer
Dim currentRow As Integer
Dim shouldHideRow As Integer
startColumn = 1     'column A
startRow = 1        'row 1
totalRows = Sheet1.Cells(Rows.Count, startColumn).End(xlUp).Row
For currentRow = totalRows To startRow Step -1
    shouldHideRow = True
    totalColumns = Sheet2.Cells(currentRow, Columns.Count).End(xlToLeft).Column
    'for each column in the current row, check the cell color
    For currentColumn = startColumn To totalColumns
        'if any colored cell is found, don't hide the row and move on to next row
        If Not Sheet1.Cells(currentRow, currentColumn).Interior.ColorIndex = -4142 Then
            shouldHideRow = False
            Exit For
        End If
    Next
    If shouldHideRow Then
        'drop into here if all cells in a row were white
        Sheet2.Cells(currentRow, currentColumn).EntireRow.Hidden = True
    End If
Next
End Sub

更改颜色某些单元格的脚本:

   Range("A8").Select
Application.CutCopyMode = False
Range("A8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=COUNTIF(Name_Preps,A8)=1"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
    .Bold = True
    .Italic = False
    .TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent3 'Changes the cell to green
    .TintAndShade = 0.4
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub

尝试更改您的病情以关注

    For currentColumn = startColumn To totalColumns
        'if any colored cell is found, don't hide the row and move on to next row
        If Sheet1.Cells(currentRow, currentColumn).Interior.ThemeColor = xlThemeColorAccent3 Then
            shouldHideRow = False
            Exit For
        End If
    Next

Interior.ColorIndex和喜欢的条件格式未检测到条件格式

如果您想继续使用,可以在此处或这里查看相关代码

但我会放弃有条件的格式以及Select/Selection/Activate/ActiveXXX模式,然后简单地使用:

Option Explicit
Sub HandleRowsColorAndVisibility()
    Dim iRow As Long
    With Range("A8", Cells(Rows.count, 1).End(xlUp)) '<--| reference cells from A8 down to column A last not empty cell
        ResetRange .Cells '<--| first, bring range formatting and visibility back to a "default" state
        For iRow = .Rows.count To 1 Step -1 '<--| then start looping through range
            If WorksheetFunction.CountIf(Range("Name_Preps"), .Cells(iRow, 1)) = 1 Then '<-- if current cell matches your criteria ...
                FormatRange .Cells(iRow, 1), True, False, 0, xlColorIndexAutomatic, xlThemeColorAccent3, 0.4 '<--| then format it
            Else '<--| otherwise...
                .Rows(iRow).Hidden = True '<--| hide it!
            End If
        Next
    End With
End Sub
Sub ResetRange(rng As Range)
    rng.EntireRow.Hidden = False
    FormatRange rng, False, False, 0, xlColorIndexAutomatic, -4142, 0
End Sub
Sub FormatRange(rng As Range, okBold As Boolean, okItalic As Boolean, myFontTintAndShade As Single, myPatternColorIndex As XlColorIndex, myInteriorThemeColor As Variant, myInteriorTintAndShade As Single)
    With rng
        With .Font
            .Bold = okBold
            .Italic = okItalic
            .TintAndShade = myFontTintAndShade
        End With
        With .Interior
            .PatternColorIndex = myPatternColorIndex
            .ThemeColor = myInteriorThemeColor
            .TintAndShade = myInteriorTintAndShade
        End With
    End With
End Sub

最新更新