Application.screenupdating falseに設定されていません

Question

私はVBAを初めて使いました。このコードは、新しい行を2つのテーブルに追加します.1つはテーブル3のテーブルに表示され、もう1つはテーブルに追加されますシート5上に隠されている。私の問題は、コードが実行されているときに、最初の広告の最後にtrueに設定されたScreenUpdatingで、画面がまだ隠れているシートを表示してちらつきます。このちらつきをどうやって止めるのですか？

  Sub Add_Observation() 
      ' 
      Application.ScreenUpdating = False 
      Sheet3.Activate 
      ActiveSheet.Unprotect 
      Sheet5.Visible = True 
        Dim Ar As Integer, Br As Integer, A As Integer 
        ' 
        Ar = Columns("B").Find(What:="S/N", After:=Range("B26")).Row 'Searching row of "S/N" header 
        Br = Range("B" & Ar).End(xlDown).Row 'Searching last row in EQUIPMENT table 
        A = (Br + 4) 
        B = (Br + 5) 

        Sheet5.Select 
        Dim Qr As Integer, Dr As Integer, D As Integer, D1 As Integer 
        ' 
        Qr = Columns("B").Find(What:="S/N", After:=Range("B16")).Row 
        Dr = Range("B" & Qr).End(xlDown).Row 
        D = (Dr + 4) 
        D1 = (Dr + 2) 


       Sheet3.Select 
       Cells(Dr, "C").Select 

      If Range(Cells(Ar, 1), Cells(A, 1)).EntireRow.Hidden = False Then 

                      Sheet3.Activate 
                       Rows(A).Insert Shift:=xlDown 'Inserting new row 
                       Cells(Br + 1, "B") = Cells(Br, "B") + 1 'Adding a sequential Number 
                       Rows(Br).Copy 'Copying format of last row 
                       Rows(Br + 1).PasteSpecial Paste:=xlPasteFormats 'Pasting format to new row 
                       Application.CutCopyMode = False 'Deactivating copy mode 

      Sheet5.Select 
      If Range(Cells(Qr, 1), Cells(D, 1)).EntireRow.Hidden = False Then 
                      Sheet5.Activate 
                       Selection.Rows(D).Insert Shift:=xlDown 'Inserting new row 
                       Rows(D1).Insert Shift:=xlDown 
                       Cells(Dr + 1, "B") = Cells(Dr, "B") + 1 'Adding a sequential Number 
                       Rows(Dr).Copy 'Copying format of last row 
                       Rows(Dr + 1).PasteSpecial Paste:=xlPasteFormats 'Pasting format to new row 
                       Application.CutCopyMode = False 'Deactivating copy mode 



      Application.ScreenUpdating = True 
      Else: GoTo G 
       End If 
      End If 

G：

  Sheet3.Activate 
       Range(Cells(Ar, 1), Cells(A, 1)).Select 
        Selection.EntireRow.Hidden = False 

      Sheet5.Activate 
       Range(Cells(Qr, 1), Cells(D, 1)).Select 
       Selection.EntireRow.Hidden = False 

      Sheet3.Select 


      Sheet5.Visible = False 
      Cells(Br, "C").Select 
      Sheet3.Activate 
      ActiveSheet.Protect 
      Application.ScreenUpdating = True 
      End Sub 

Answer 1

私はちょうどあなたのアイデアを与えるために最初のビットを行うだろう：それはその場しのぎのようなものだ

Sub Add_Observation() 
     ' 
     Application.ScreenUpdating = False 
     with Sheet3 
      .Unprotect 
     End With 
     With Sheet5 
       Dim Ar As Integer, Br As Integer, A As Integer 
       ' 
       Ar =. Columns("B").Find(What:="S/N", After:=.Range("B26")).Row 'Searching row of "S/N" header 
       Br = .Range("B" & Ar).End(xlDown).Row 'Searching last row in EQUIPMENT table 
       A = (Br + 4) 
       B = (Br + 5) 


       Dim Qr As Integer, Dr As Integer, D As Integer, D1 As Integer 
       ' 
       Qr = .Columns("B").Find(What:="S/N", After:=.Range("B16")).Row 
       Dr = .Range("B" & Qr).End(xlDown).Row 
       D = (Dr + 4) 
       D1 = (Dr + 2) 

    end With 
     With Sheet3 
      'Cells(Dr, "C").Select 

     If .Range(.Cells(Ar, 1), .Cells(A, 1)).EntireRow.Hidden = False Then 

with sheet5 
    .Rows(Dr + 1).PasteSpecial Paste:=xlPasteFormats 'Pasting format to new row 

     Application.CutCopyMode = False 'Deactivating copy mode 

.Rows(D).Insert Shift:=xlDown 'Inserting new row 

    .Rows(D1).Insert Shift:=xlDown 

    .Cells(Dr + 1, "B") = 'Cells(Dr, "B") + 1 'Adding a sequential Number 

    .Rows(Dr).Copy 'Copying format of last row 

Answer 2

が、上の画面の更新をオンにしようとすると、あなたのルーチンの外に別のサブルーチンでルーチンをラップすることによってオフにします。

コードからapplication.screenupdating行をすべて削除します。そうしないと、以下のコードが上書きされます。

Public Sub callAdd_Observation() 
    Application.ScreenUpdating = False 
    Call Add_Observation 
    Application.ScreenUpdating = True 
End Sub