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

当红色边框 （列AX）中的单元格包含文本“NoBO”（= No Backorder）而不会丢失公式中的公式时，我想要创build一个清除蓝色边框 （〜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 

给我一个错误“溢出”。 search后，我知道这个错误意味着什么，但我找不到解决scheme。

tl; dr – 我想删除范围B6：B #####（直到最后一行）到AN6：AN #### *（直到最后一行）如果单元格AX ##### containts NoBO

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 

我认为Unionfunction最多只能存储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 

我testing了这个40k行，它工作正常。 由于没有，执行需要一段时间。 行的也许。