使用 VBA 识别包含文本子字符串的 Excel 工作表的特定行

Question

在我的工作中，我们获得了带有多个工作表的 Excel 文件，这些工作表是从各种数据源中提取的。有些工作表的末尾插入了标准化的免责声明，有些则没有。但是，当免责声明出现时，它们总是以相同的文本开头，并且总是出现在同一列中。我正在尝试编写一个 VBA 脚本来搜索整个 Excel 文件；确定免责声明是否存在，如果存在，它们从哪一行开始；然后清除从该行到最后使用的行的所有单元格。

据我通过搜索 StackOverflow 和其他资源得知，下面的代码应该可以工作。但是由于某种原因，它实际上从未识别出密钥子字符串何时存在（即使它存在）。谁能指出我哪里出错了？

Option Explicit

Option Base 1

Sub Delete_Disclaimers()

' Turn off screen updating for speed

Application.ScreenUpdating = False


' Define variables

Dim ws As Worksheet
Dim TextCheck As String
Dim StartRow As Integer
Dim EndRow As Integer
Dim SearchColumn As Integer
Dim CheckVal As Integer
Dim CurrentCell As Range
Dim RowCount As Integer
Dim SearchText As String


' Cycle through each worksheet in the workbook
For Each ws In ActiveWorkbook.Worksheets


'Set some initial variables for this worksheet

SearchColumn = 2
StartRow = 1
SearchText = "Disclaimer"

' Set EndRow to the last row used in the worksheet
EndRow = CInt(ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row)


' Find the cell, if any, that has the text by searching just in column B to speed things up.  Also limit to the first 200 rows
' for speed since there don't seem to have any sheets longer than that.    

For RowCount = 1 To 200
    Set CurrentCell = ws.Cells(2, RowCount)
    TextCheck = CurrentCell.Text
    If Not TextCheck = "" Then
        CheckVal = InStr(1, TextCheck, SearchText, 1)
        If CheckVal > 0 Then
            StartRow = RowCount
            MsgBox ("Start Row is " & CStr(StartRow))
            Exit For
        End If
    End If
Next RowCount


' If the search text was found, clear the range from the start row to the end row. 

If StartRow > 1 Then
    ws.Range(ws.Cells(1, StartRow), ws.Cells(50, EndRow)).Clear
End If



' Loops to next Worksheet
Next ws


' Turn screen updating back on
Application.ScreenUpdating = True


' Display a message box that all sheets have been cleared, now that screenupdating is back on
MsgBox "All Worksheets have been cleared!"


End Sub

Answer 1

您的单元格语法不正确。它应该是 Cells(row, col)。你有 row 和 col 转置。

Answer 2

我的解决方案最终是上述两个答案的组合。但是 .Clear 部分是我忽略的一个主要问题。这是完整更新的代码，以防其他人遇到类似问题。

Option Explicit

Option Base 1

Sub Delete_Portfolio_Holdings()

' Turn off screen updating for speed

Application.ScreenUpdating = False


' Define variables

Dim ws As Worksheet
Dim TextCheck As String
Dim StartRow As Integer
Dim EndRow As Integer
Dim SearchColumn As Integer
Dim CheckVal As Integer
Dim CurrentCell As Range
Dim RowCount As Integer
Dim SearchText As String
Dim ClearRange As Range

Dim WScount As Integer
Dim cws As Integer


' Cycle through each worksheet in the workbook

WScount = ActiveWorkbook.Worksheets.Count

For cws = 1 To WScount


'Set some initial variables for this worksheet

SearchColumn = 2
StartRow = 1
SearchText = "Disclaimer"
Set ws = ActiveWorkbook.Worksheets(cws)

' Set EndRow to the last row used in the worksheet
EndRow = CInt(ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row)


' Find the cell, if any, that has the text by searching just in column B to speed things up.  Also limit to the first 200 rows
' for speed since you don't seem to have any sheets longer than that.  You can always change to increase if necessary.  Cells.Find
' does not return anything if there is no match for the text, so CurrentRow may not change.

With ws.Range("b1:b200")
   Set CurrentCell = ws.Cells.Find(What:=SearchText, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
   If Not CurrentCell Is Nothing Then
        StartRow = CInt(CurrentCell.Row)
   End If
End With


' Now if the text was found we now have identified the start and end rows of the caveats, we can clear columns A through BB with the .Clear function.  Choice of column BB is arbitary.

If StartRow > 1 Then
    Set ClearRange = ws.Range(("A" & StartRow), ("BB" & EndRow))
    MsgBox ("ClearRange is " & CStr(ClearRange.Address))
    ClearRange.Clear
End If



' Loops to next Worksheet
Next cws


' Turn screen updating back on
Application.ScreenUpdating = True


' Display a message box that all sheets have been cleared, now that screenupdating is back on
MsgBox "All Worksheets have been cleared!"


End Sub