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）。你有行和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

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

2 个答案: