如果单元格包含特定文本，则清除范围的内容

Question

我想制作一个宏，以清除红色边框 （第AX列）中的单元格包含文本“ NoBO”（=“无延期交货”）时清除蓝色边框 （〜40.000行）中单元格的内容，而不会丢失列AP：AX。

Sub clear_ranges()
Dim ws As Worksheet
Dim x As Integer
Dim clearRng As Range

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Sheets("Input")

For x = 6 To ws.Range("B" & Rows.Count).End(xlUp).Row
    If (ws.Range("AX6" & x).Value = "NoBO") Then
        If clearRng Is Nothing Then
            Set clearRng = ws.Range("B6" & x & ":" & "AN6" & x)
        Else
            Set clearRng = Application.Union(clearRng, ws.Range("B6" & x & ":" & "AN6" & x))
        End If
    End If
Next x
clearRng.Clear
End Sub

由于某些原因：

For x = 6 To ws.Range("B" & Rows.Count).End(xlUp).Row

给我一个错误“溢出”。 搜索后，我知道此错误是什么意思，但我无法找到解决方案。

tl; dr-如果单元格AX #####包含NoBO，我想删除范围B6：B #####（至最后一行）到AN6：AN #### *（至最后一行）

Answer 1

使用Integer太容易溢出。 更换：

Dim x As Integer 

与：

Dim x As Long

Answer 2

尝试：

Sub clear_ranges() 

Dim ws As Worksheet 
Dim x As Integer 
Dim clearRng As Range

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Sheets("Input")

For x = 6 To ws.Range("B" & Rows.Count).End(xlUp).Row
    If ws.Range("AX" & x).Value = "NoBO" Then
        ws.Range("B" & x & ":" & "AN" & x).Clear
    End If
Next x

Application.ScreenUpdating = True

End Sub

我认为“ Union功能最多只能存储30个范围，因此可能不适合您的需求。

Answer 3

您好，如果您要删除行，最好使用For Each循环，或者从列的底部开始进行处理。

'Loop through cells A6:Axxx and delete cells that contain an "x."
   For Each c In Range("AX6:A" & ws.Range("B" & Rows.Count).End(xlUp).Row)
       If c.Value2 = "NoBo" Then

             Set clearRng = ws.Range("B" & c.Row & ":" & "AN" & c.Row)

       End If
       clearRng.Clear
   Next    

Answer 4

尝试这个

Option Explicit

Sub clear_ranges()
Dim ws As Worksheet

Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Input")
With ws
    With .Range("B5:AX" & .Cells(.Rows.Count, "B").End(xlUp).Row) 'take all data
        .AutoFilter Field:=49, Criteria1:="NoBO" 'filter to keep only rows with "NoBO" in column "AX" (which is the 49th column from column "B"
        With .Offset(1).Resize(.Rows.Count - 1) 'offset from headers
            If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 0 Then Intersect(.SpecialCells(xlCellTypeVisible), ws.Columns("B:AN")).ClearContents 'clear cells in columns "B:AN" of filtered rows
        End With
        .AutoFilter 'remove autofilter
    End With
End With

Application.ScreenUpdating = True
End Sub

Answer 5

你可以试试

假设“ AX列”中没有空白单元格

Sub clr_cell()

For i = 6 To ActiveSheet.Range("AX6", ActiveSheet.Range("AX6").End(xlDown)).Rows.Count
'counts the no. of rows in AX and loops through all

If ActiveSheet.Cells(i, 50).Value = "NoBo" Then

ActiveSheet.Range(Cells(i, 2), Cells(i, 40)).ClearContents
'clears range B to AN

End If

Next i

End Sub

我在40k行上对此进行了测试，效果很好。 由于没有，执行需要一段时间。 行。