簡體   English   中英

VBA - 刪除包含黑色文本的范圍中的每個單元格的行

[英]VBA - Remove rows that have every cell in the range that contain black text

我的任務是分析一個工作簿,我需要根據文本與行相關的顏色(紅色或黑色)來隔離數據。

我基本上需要開發一個宏,它將刪除包含范圍內所有黑色的數據(文本)的所有行(列CJ),並保留包含該范圍中至少一個單元格的所有行(列CJ)包含'red'(255,0,0)的文本。

完成的結果應該是每行至少包含一個在CJ列之間包含紅色文本的單元格。

數據設置如下:

名稱:

A1,B1

A2,B2一直到

A2000,B2000

數據(文本)設置如下:

C1到J1

C2到J2一直到

C2000,J2000

我發現了許多有條件顏色格式的代碼,但我似乎無法開發出符合我上面要求的代碼。

任何幫助將不勝感激。

你可以嘗試:

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

您可以使用AutoFilter按字體顏色進行過濾。 顏色是通過手動格式化還是條件格式化得出並不重要。

在您的情況下,您在許多列中“證明負面”。 有必要使用輔助列。 下面的代碼循環遍歷列C:J並在每次遇到帶有紅色字體的過濾行時標記“幫助”列。

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

我已經注釋掉刪除'幫助'列。 'helper'是主過濾器列,因此刪除它也會刪除AutoFilter。

我也可以提供另一種意見,只是為了好玩。 :-)

將下面的內容復制並粘貼到新模塊中,選擇要在其上運行的單元格區域,然后執行宏。

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

...它沒有綁定到您的列,它將隨您所做的選擇而移動。

選擇單元格

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM