こんにちは、私はこの 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