Question

大家好我制作了这个vba程序，它所做的就是通过每个工作表并删除一些单元格和单词很好我把它编写成第7页我需要一种方法来阻止它运行Say如果只有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

Answer 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

全部放在一起......

这是未经测试的，但我应该考虑做你正在做的一切。它代码少得多，如果遇到问题或者需要修改内容，可以更容易地阅读和调试。

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

使用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

Excel Vba需要停止

1 个答案: