-1

こんにちは、私はこの VBA プログラムを作成しました。各シートを調べて、いくつかのセルと単語を削除します。シート 7 まで作成しました。実行を停止する方法が必要です。シートが 5 つしかない場合は、それが必要です。エラーが発生するため、5 で停止し、他の 2 つを実行しようとしません。

私はこれに非常に慣れていないので、これを見て、それを短くしたり、より良く実行したりできるかどうかを確認してください。

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