Excel Vba需要停止

-1

大家好我做了这个VBA程序，它是做什么是去通过每个工作表，并删除一些单元格和单词的好，我做了它到表7我需要一种方法来阻止它运行说如果只有5张我希望它停止在5，而不是尝试运行其他两个，因为它出错了。Excel Vba需要停止

我是非常非常新的这个，你也可以看看这个，看看你是否能够缩短它，或者使它运行得更好。

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

来源

2013-09-21 Dmcovey1993

我需要的是一种方法来阻止它，如果没有更多的张留 – Dmcovey1993

大卫Zemens你能帮忙吗？ – Dmcovey1993

请参阅下面的答案。它没有经过测试，因为我不打算尝试复制您的工作簿，但它应该让您了解如何使您的代码更高效。 –

以下是一些一般性建议：停止依靠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

这是宏录制如何让你的代码 - ，它是几乎每个人如何与VBA开始在Excel所以在它没有羞耻。但录音机是非常直观的，记录每个击键，选择，激活等。它是有用的看到发生了什么，但几乎总是可以巩固。整合代码使其更具人性化，更快速执行并易于维护。

与此相比，该代码：

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

而不是写一个宏，模仿指向和点击，我修改工作直接上的对象（表，细胞，范围在/ etc）。

现在，我们还只用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语句可以根据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-21 02:24:00

大卫我得到了编译错误，没有下一个 – Dmcovey1993

大卫我需要跟你说话 – Dmcovey1993

@pnuts谢谢你绝对正确这段代码没有经过测试我会修改 –

Excel Vba需要停止

回答

相关问题