VBA - 删除包含黑色文本的范围中的每个单元格的行

Question

I've been tasked to analyse a workbook where I need to isolate the data based on the colour (red or black) that the text is in relating to the rows.

I essentially need to develop a macro that will remove all the rows that contain data (text) that is 'all black' in the range (column CJ) and leave all the rows that contain at least one cell in the range (column CJ) that contains text that is 'red' (255,0,0).

The completed result should be that every row will contain at least one cell that contains red text between between Column CJ.

The data is set our as follows:

Names:

A1,B1

A2,B2 all the way to

A2000,B2000

Data (text) is set up like the following:

C1 to J1

C2 to J2 all the way to

C2000, J2000

I've found numerous codes that conditionally colour format but I can't seem to develop one that does what I want above.

Any help will be greatly appreciated.

Answer 1

You could try:

Option Explicit

Sub test()

    Dim i As Long

    With ThisWorkbook.Worksheets("Sheet1")

        For i = 2000 To 2 Step -1

            If .Range("C" & i).Value = "" And .Range("D" & i).Value = "" And .Range("E" & i).Value = "" And .Range("F" & i).Value = "" _
                And .Range("G" & i).Value = "" And .Range("H" & i).Value = "" And .Range("I" & i).Value = "" And .Range("J" & i).Value = "" Then

                .Rows(i).Delete

            End If

        Next i

    End With

End Sub

Answer 2

You can use AutoFilter to filter by font color. It does not matter whether the color was derived by manual formatting or conditional formatting.

In your case, you are 'proofing a negative' across many columns. A helper column appears necessary. The code below cycles through columns C:J and marks the 'helper' column every time it encounters filtered rows with a red font.

Sub anyRedFont()

    Dim c As Long

    With Worksheets("sheet1")

        'remove any AutoFilters
        If .AutoFilterMode Then .AutoFilterMode = False

        'insert a 'helper' column and label it
        .Columns("C").Insert
        .Cells(1, "C") = "helper"

        'filter for red font color
        With .Range(Cells(1, "C"), .Cells(.Rows.Count, "K").End(xlUp))

            'cycle through columns looking for red font
            For c = 2 To 9

                'fliter for red font
                .AutoFilter Field:=c, Criteria1:=vbRed, _
                            Operator:=xlFilterFontColor, VisibleDropDown:=False

                'put a value into the 'helper' column
                On Error Resume Next
                With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
                    Debug.Print .SpecialCells(xlCellTypeVisible).Address(0, 0)
                    .SpecialCells(xlCellTypeVisible) = 1
                End With
                On Error GoTo 0

                'remove fliter for red font
                .AutoFilter Field:=c

            Next c

            'fliter for non-blank helper column
            .AutoFilter Field:=1, Criteria1:=1, VisibleDropDown:=False

        End With

        'Do your work with the rows containing at least one cell
        'with red font here

        'remove 'helper' column
        'this removes the AutoFilter since the 'helper' column
        'is the primary filter column at this point
        '.Columns(Application.Match("helper", .Rows(1), 0)).Delete

        'remove AutoFilter (manually with Data, Data Tools, Clear)
        'If .AutoFilterMode Then .AutoFilterMode = False

    End With

End Sub

I've commented out removing the 'helper' column. The 'helper' is the primary filter column so removing it also removes the AutoFilter.

Answer 3

I may as well offer another opinion, just for fun. :-)

Copy and paste the below into a new module, select the area of cells you want to run this over and then execute the macro.

Public Sub RemoveAllRowsWithBlackText()
    Dim rngCells As Range, bFoundNonBlack As Boolean, lngRow As Long
    Dim lngCol As Long

    Set rngCells = Selection

    Application.ScreenUpdating = False

    With rngCells
        For lngRow = .Rows.Count To 1 Step -1
            bFoundNonBlack = False

            For lngCol = 1 To .Columns.Count
                If .Cells(lngRow, lngCol).Font.Color <> 0 And Trim(.Cells(lngRow, lngCol)) <> "" Then
                    bFoundNonBlack = True
                    Exit For
                End If
            Next

            If Not bFoundNonBlack Then
                .Cells(lngRow, lngCol).EntireRow.Delete xlShiftUp
            End If
        Next
    End With

    Application.ScreenUpdating = True
End Sub

... it's not bound to your columns, it will move with the selection you make.