Worksheet_設定範囲の設定が遅い

Question

Excelのボタンの可視性を管理するためのExcelマクロが、別のSOの質問hereに基づいて "Worksheet_Change"関数で使用されています。

マクロは動作しますが、Excelシートを更新するのに時間がかかります。私は、単一の行に遅さを突き止めるために管理している：

Set rUpdated = Range(Target.Dependents.Address) 

これは後でスクリプト内で反復処理されるように、変数に更新セルの範囲を設定します。この行だけでスクリプトを呼び出すと、これがすべての遅延であることがわかりました。それはかなり簡単な行に見えますが、それを行うにはよりよい方法がありますか？

全開示：

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim rUpdated As Range 
    Dim shp As Shape 
    Dim rCell As Range 
    Set rUpdated = Range(Target.Dependents.Address) 
    If Not rUpdated Is Nothing Then 
     For Each rCell In rUpdated 
      If rCell.Column = 1 Then 
       'Look at each shape in the sheet and cross-reference with rCell. 
       For Each shp In Target.Parent.Shapes 
        If shp.TopLeftCell.Row = rCell.Row Then 
         shp.Visible = (rCell.Value <> "") 
         Exit For 'Exit the loop - the correct button has been found. 
        End If 
       Next shp 
      End If 
     Next rCell 
    End If 
End Sub 

Answer 1

私は、以下の1行（およびコンパニオンライン）とその設定を置き換え：

On Error Resume Next 
ActiveSheet.Shapes("buttonRow" & Target.Row).Visible = (ActiveSheet.Cells(Target.Row, 1).Value <> "") 

しかし、これは私が最初に私のすべての図形の名前を変更するのに必要な仕事を得るために。私はそれを行うためにこの機能を使いました：

Function renamebuttons() 
    For Each shp In ActiveSheet.Shapes 
     shp.name = "buttonRow" & shp.TopLeftCell.Row 
    Next shp 
End Function 

私はその機能を一度実行して削除しました。いったん完了すると、私の形状は名前で参照できるようになり、もはやすべての形状とターゲットに依存するサイクリングの遅れが発生しなくなりました。ワークシートでの遅延は最小限に抑えられています。

Answer 2

だから私はあなたのように行のセルが変更された場合、ボタンが見えるようにしたいそれを正しく理解している場合。それを遅くするために私が考えることができる唯一のものは、それは多くのrCellまたはShapesをチェックする必要があります。私はあなたの文書の構造が何であるか知りません。だから私のアイデアは：毎回すべての形を通過するのではなく、行の中でそれらを識別できるパターンで名前を付けるので、名前を使用してアドレス指定することができます（つまり、Row2ボタンを行に入れて2 ）。

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim rUpdated As Range 
    Dim shp As Shape 
    Dim rCell As Range 
    Dim obj As OLEObject 

    Set rUpdated = Range(Target.Dependents.Address) 
    If Not rUpdated Is Nothing Then 
     For Each rCell In rUpdated 
      If rCell.Column = 1 Then 
       On Error Resume Next 
       Set obj = ActiveSheet.OLEObjects("Row" & rCell.Row) 
       If Err.Number = 0 Then 
        obj.Visible = (rCell.Value <> "") 
       End If 
      End If 
     Next rCell 
    End If 
End Sub