-1

大家好，我制作了这个vba程序，它的作用是遍历每张纸并删除一些单元格和单词，我把它写到第7张我需要一种方法来阻止它运行说如果只有5张我想要它停止在 5 并且不要尝试运行另外两个，因为它会出错。

我对此非常陌生，你也可以看看这个，看看你是否能够缩短它或者让它运行得更好。

Sub Step1()


' 9/20/2013
' Made by Douglas Covey




    Sheets("1D_report").Select
    Rows("3:9").Select
    Selection.Delete Shift:=xlUp
    Range("E1:F2").Select
    Selection.ClearContents
    Columns("H:H").Select
    Selection.ClearContents
    Selection.ClearContents

   '
   ' Search and Delete.
   '

    Dim r As Range
    Dim s As String
    s = "Utilization, %"
    Set r = Cells.Find(What:=s, After:=Range("A1"))
    If r Is Nothing Then
        MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
        Exit Sub
    End If
    Range(r, r.Offset(8, 0)).Clear

        Set r = Cells.Find(What:=s, After:=Range("A1"))
    If r Is Nothing Then
        MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
        Exit Sub
    End If
    Range(r, r.Offset(0, 1)).Clear

        s = "Total Cost:"
    Set r = Cells.Find(What:=s, After:=Range("A1"))
    If r Is Nothing Then
        MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
        Exit Sub
    End If
    Range(r, r.Offset(0, 1)).Clear

    Sheets("1D_report").Name = "Comingsoon_report"


    '
    ' Sheet Number Two
    '


   Sheets("1D_1").Select


    Rows("4:9").Select
    Selection.Delete Shift:=xlUp
               s = "Qty:"
    Set r = Cells.Find(What:=s, After:=Range("A1"))
    If r Is Nothing Then
        MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
        Exit Sub
    End If
    Range(r, r.Offset(0, 1)).Delete Shift:=xlUp


      Range("E8").Select
    Cells.Find(What:="Page", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Replace What:="Page", Replacement:="Program", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    '
    ' Sheet Number Tree
    '


      Sheets("1D_2").Select


    Rows("4:9").Select
    Selection.Delete Shift:=xlUp
               s = "Qty:"
    Set r = Cells.Find(What:=s, After:=Range("A1"))
    If r Is Nothing Then
        MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
        Exit Sub
    End If
    Range(r, r.Offset(0, 1)).Delete Shift:=xlUp


      Range("E8").Select
    Cells.Find(What:="Page", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Replace What:="Page", Replacement:="Program", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False



    '
    ' Sheet Number Four
    '


        Sheets("1D_3").Select


    Rows("4:9").Select
    Selection.Delete Shift:=xlUp
               s = "Qty:"
    Set r = Cells.Find(What:=s, After:=Range("A1"))
    If r Is Nothing Then
        MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
        Exit Sub
    End If
    Range(r, r.Offset(0, 1)).Delete Shift:=xlUp


      Range("E8").Select
    Cells.Find(What:="Page", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Replace What:="Page", Replacement:="Program", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False




    '
    ' Sheet Number Five
    '



        Sheets("1D_4").Select


    Rows("4:9").Select
    Selection.Delete Shift:=xlUp
               s = "Qty:"
    Set r = Cells.Find(What:=s, After:=Range("A1"))
    If r Is Nothing Then
        MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
        Exit Sub
    End If
    Range(r, r.Offset(0, 1)).Delete Shift:=xlUp


      Range("E8").Select
    Cells.Find(What:="Page", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Replace What:="Page", Replacement:="Program", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False



    '
    ' Sheet Number Six
    '



            Sheets("1D_5").Select


    Rows("4:9").Select
    Selection.Delete Shift:=xlUp
               s = "Qty:"
    Set r = Cells.Find(What:=s, After:=Range("A1"))
    If r Is Nothing Then
        MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
        Exit Sub
    End If
    Range(r, r.Offset(0, 1)).Delete Shift:=xlUp


      Range("E8").Select
    Cells.Find(What:="Page", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Replace What:="Page", Replacement:="Program", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False





    '
    ' Sheet Number Seven
    '




            Sheets("1D_6").Select


    Rows("4:9").Select
    Selection.Delete Shift:=xlUp
               s = "Qty:"
    Set r = Cells.Find(What:=s, After:=Range("A1"))
    If r Is Nothing Then
        MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
        Exit Sub
    End If
    Range(r, r.Offset(0, 1)).Delete Shift:=xlUp


      Range("E8").Select
    Cells.Find(What:="Page", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Replace What:="Page", Replacement:="Program", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False


End Sub
4

1 回答 1

1

以下是一些一般性建议：停止依赖Selection. 看看这段代码（你的）：

Sheets("1D_report").Select
Rows("3:9").Select
Selection.Delete Shift:=xlUp
Range("E1:F2").Select
Selection.ClearContents
Columns("H:H").Select
Selection.ClearContents
Selection.ClearContents   "<-- This line is redundant

这就是宏记录器为您提供代码的方式——这也是几乎每个人都从 Excel 中的 VBA 开始的方式，因此没有什么可耻的。但是记录器是非常真实的，记录每一次击键、选择、激活等。它对于查看发生了什么很有用，但几乎总是可以合并。合并代码使其更易于阅读，执行速度更快，并且更易于维护。

将其与此代码进行比较：

With Sheets("1D_report")
    .Rows("3:9").Delete Shift:=xlUP
    .Range("E1:F2").ClearContents
    .Range("H:H").ClearContents
End With

我没有编写模拟点击的宏，而是将其修改为直接在对象（工作表、单元格、范围/等）上工作。

现在，让我们也只了解您对1D_Report工作表所做的事情，并向您展示如何使用子例程/函数。

Sub Test()
    Dim r As Range
    Dim s As String
    Dim ws as Worksheet

    If Not SearchAndClear(Worksheets("1D_report"), "Utilization, %", 8, 0) Then Exit Sub
    If Not SearchAndClear(Worksheets("1D_report"), "Utilization, %", 0, 1) Then Exit Sub
    If Not SearchAndClear(Worksheets("1D_report"), "Total Cost:", 0, 1) Then Exit Sub
End Sub

上面的代码依赖于一个函数来执行可重复的操作。这是功能：

Function SearchAndClear(ws As Worksheet, srchString As String, rOff As Long, cOff As Long) As Boolean
    With ws
        Set r = .Cells.Find(srchString, .Range("A1"))
        If r Is Nothing Then
            MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
            SearchAndClear = False
        End If
        .Range(r, r.Offset(rOff, cOff)).Clear
        SearchAndClear = True
    End With
End Function

把它们放在一起...

这是未经测试的，但我认为应该做你正在做的一切。它的代码少了很多，如果您遇到问题或需要修改内容，则更容易阅读和调试。

为可重复的代码创建函数/子例程是很有价值的，这样您就不需要重复它，您只需多次调用函数/子。如果您需要更改代码，这只是您将来需要修复或修改的一件事，而不是许多需要更新的内容。

使用该Select Case语句允许您根据案例值执行特定操作，在这种情况下，我们正在检查工作表的名称。它永远不会对不存在的工作表起作用:)

Sub Test()
        Dim r As Range
        Dim s As String
        Dim ws As Worksheet
        For Each ws In ActiveWorkbook.Worksheets
            Select Case ws.Name
                Case "1D_report"
                    With ws
                        .Rows("3:9").Delete Shift:=xlUp
                        .Range("E1:F2").ClearContents
                        .Range("H:H").ClearContents
                    End With
                    If Not SearchAndClear(ws, "Utilization, %", 8, 0) Then Exit Sub
                    If Not SearchAndClear(ws, "Utilization, %", 0, 1) Then Exit Sub
                    If Not SearchAndClear(ws, "Total Cost:", 0, 1) Then Exit Sub
                    ws.Name = "Comingsoon_report"

                Case "1D_1", "1D_2", "1D_3", "1D_4", "1D_5", "1D_6"  '<-- You do the same operations on ALL of these sheets!
                    With ws
                        .Rows("4:9").Delete Shift:=xlUp
                    End With
                    If Not SearchAndClear(ws, "Qty:", 0, 1) Then Exit Sub

                    Set r = ws.Cells.Find(What:="Page", After:=ws.Range("E8"), LookIn:=xlFormulas, LookAt _
                        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                        False, SearchFormat:=False)
                    r.Replace What:="Page", Replacement:="Program", LookAt:=xlPart, _
                        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                        ReplaceFormat:=False

                Case Else
                'You could add additional logic for other worksheets, if needed
                '
                '

            End Select
        Next                
    End Sub
    Function SearchAndClear(ws As Worksheet, srchString As String, rOff As Long, cOff As Long) As Boolean
    With ws
        Set r = .Cells.Find(srchString, .Range("A1"))
        If r Is Nothing Then
            MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
            SearchAndClear = False
        End If
        .Range(r, r.Offset(rOff, cOff)).Clear
        SearchAndClear = True
    End With
End Function
于 2013-09-21T02:24:00.947 回答