VBAコード今日のデータ検証

Question

セルA2〜A999でデータ検証が行われているドロップダウンメニューの唯一のオプションが "Today"（引用符は含みません）のスプレッドシートがあります。私は今日の日付にセルの値を変更するVBAコードを持っています "今日"がセルで選択されています。しかし、このコードには問題があります。今日の日付が入っているセルを含むセルのグループの内容をクリアすると、スプレッドシートは考えてからデバッグして閉じます。例えばA1 & B1を同時にクリアする。 しかし、私はそれ自身でA1をクリアすると、問題なくセルをクリアします。

P.S. 「明確にする」とは、「マウスで細胞のグループを選択し、バックスペースボタンを押す」と言っていました。

データ検証付きのセルを含め、多くのセルを同時に消去できるようにコードを修正する手助けがありますか。

以下のように私は、ワークシートの部分に貼り付けられている使用しているのですコード：

Private Sub Worksheet_Change(ByVal Target As Range) 

    selectedVal = Target.Value 

If Target.Column = 1 Then 
    selectedNum = Application.VLookup(selectedVal, Worksheets("DATA- 
O").Range("DateToday"), 2, False) 

    If Not IsError(selectedNum) Then 
     Target.Value = selectedNum 
    End If 
    End If 
End Sub 

Answer 1

のそれぞれをループし（ディルクライヒェルだけのコメントで述べたように）あなたの問題への答えがある

影響を受けた細胞：

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim c As Range 
    If Not Intersect(Columns(1), Target) Is Nothing Then 
     For Each c In Intersect(Columns(1), Target).Cells 
      selectedVal = c.Value 
      selectedNum = Application.VLookup(selectedVal, Worksheets("DATA-O").Range("DateToday"), 2, False)  
      If Not IsError(selectedNum) Then 
       Application.EnableEvents = False 'As recommended by K Paul 
       c.Value = selectedNum 
       Application.EnableEvents = True 
      End If 
     Next 
    End If 
End Sub 

---

しかし、あなただけ使用していない理由は、私はわからないんだけど、あなたはコードがやっていることを言うことに基づく：

​​

Answer 2

高速にしたい場合は、2つの方法があります。

使用Evaluateはそれを行うには、配列のような：も非常に速いことができ

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Columns(1), Target) Is Nothing Then 
    With Intersect(Columns(1), Target) 
     If Evaluate("AND(" & .Address & "<>""Today"")") Then Exit Sub 
     .Value = Evaluate("IF(" & .Address & "=""Today"",TODAY()," & .Address & ")") 
    End With 
    End If 
End Sub 

または使用Range.Replace：

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Columns(1), Target) Is Nothing Then 
    Intersect(Columns(1), Target).Replace "Today", Date, xlWhole, , True, , False, False 
    End If 
End Sub 

小さなヒント：押すCTRL&;は、今日の日付に直接入力します