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

我想制作一个宏，当红色边框（列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（直到最后一行），请尝试：

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个范围，因此可能无法满足您的需要。

尝试：

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个范围，因此它可能不适合您的需要。

您好，如果您要删除行，最好使用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    

---

您好，如果要删除行，最好使用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    

---

使用

Integer

很容易产生溢出。替换：

Dim x As Integer 

与：

---

使用

Integer

很容易产生溢出。替换：

Dim x As Integer 

与：

试试这个

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

试试这个

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

你可以试试

假设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

我在4万行上测试了这个，效果很好。由于行数可能需要一些时间才能执行。

您可以尝试

假设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

---

我在4万行上测试了这个，效果很好。由于行数可能需要一段时间才能执行。

x是一个

整数

，最多只能保存32767的值，因此如果数据超出该行，则会溢出最大值x。正如Gary的回答所述-将其更改为

长

，这样效率更高。x是一个

整数

，最多只能保存32767的值，因此如果数据超出该行，它将溢出最大值x。正如Gary的回答所述-将其更改为

Long

，这样效率更高。@Bluesector根据此响应的建议，将

X

从

Integer

更改为

Long

时发生了什么？

clearRng.Clear

（代码结束）现在给我一个错误。。。我有点困惑，我以为这只是一个溢出对象变量或不带块变量set@Bluesector根据此响应的建议，将

X

从

Integer

更改为

Long

时发生了什么？

clearRng.Clear

（代码末尾）现在给我一个错误。。。我有点困惑，我以为这只是一个溢出对象变量或块变量未设置。

。自动筛选字段：=48，准则1:=“NoBO”

范围类的自动筛选方法失败。

。自动筛选字段：=48，准则1:=“NoBO”

范围类的自动筛选方法失败