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



在我的工作中,我们获得了带有多个工作表的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

您的Cells语法不正确。它应该是单元格(行,列)。你已经把行和列互换了。

我的解决方案最终是上面两个答案的组合。但清晰的部分是定义,这是我忽略的一个主要问题。以下是完整的更新代码,以防对其他有类似问题的人有所帮助。

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

最新更新