こんなこと可能ですか?

質問

A3とB3に数値が入力されています。
両方、またはどちらか一方の値が変わるたびにA1の値に+１していきA3、B3の値が両方0になった時A1も0にしたいのですが可能でしょうか？
説明がわかりにくいかもしれませんが
A1にA3とB3のセル両方、又は一方の値が変更された回数を表示しているということです。

回答No.1

Zero_0 · ベストアンサー

こんなのではどうでしょう。
Private Sub worksheet_change(ByVal target As Range)
If target.Column = 1 And target.Row = 3 Then Cells(1, 1) = Cells(1, 1) + 1
If target.Column = 2 And target.Row = 3 Then Cells(1, 1) = Cells(1, 1) + 1
If Cells(3, 1) = 0 And Cells(3, 2) = 0 Then Cells(1, 1) = 0
End Sub
A3,B3どちらかのセルを変更するとカウントされます。

回答No.3

Wendy02

私の場合、同時入力する方法は、消去以外は、無視することにしました。
また、文字の入力に関しても、無視します。

今回、あまり、すっきりとしたコードが書けなかったです。理由は、いくつかの問題に、こだわってしまいました。
なお、これは、ワークシートモジュールですから、ワークシートの一番下のシート名のタブを右クリックして、コードの表示で、以下を貼り付けます。
'--------------------------------------------------
Dim vrtRng(1) As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Static lngCount As Long
If Intersect(Target, Range("A3", "B3")) Is Nothing Then Exit Sub
　Application.EnableEvents = False
　If Not IsArray(Target) Then
　　If IsNumeric(Target.Value) Then
　　　If Range("A3").Value <> 0 Or Range("B3").Value <> 0 Then
　　　　If vrtRng(0) <> Range("A3").Value _
　　　　　Or vrtRng(1) <> Range("B3").Value Then
　　　　　lngCount = lngCount + 1
　　　　　Range("A1").Value = lngCount
　　　　　vrtRng(0) = Range("A3").Value: vrtRng(1) = Range("B3").Value
　　　　 End If
　　　　ElseIf Range("A3").Value = 0 And Range("B3").Value = 0 Then
　　　　　lngCount = 0
　　　　　Range("A1").Value = 0
　　　　　vrtRng(0) = Empty: vrtRng(1) = Empty
　　　　End If
　　End If
　　Else
　　If Target.Cells(1, 1).Value = 0 _
　　　　And Target.Cells(1, 2).Value = 0 Then
　　　lngCount = 0
　　　Range("A1").Value = 0
　　　vrtRng(0) = Empty: vrtRng(1) = Empty
　　End If
　End If
　Application.EnableEvents = True
End Sub
'--------------------------------------------------

回答No.2

maruru01

こんにちは。maruru01です。

>両方、またはどちらか一方の値が変わるたびに
ということは、元の値を保持しておいて、比較する必要があるのかも知れません。
その場合は、以下のコードをシートのモジュールに貼り付けます。

Private A3_Value As Variant
Private B3_Value As Variant

Private Sub Worksheet_Activate()

　　A3_Value = Range("A3").Value
　　B3_Value = Range("B3").Value
　　If Not IsNumeric(Range("A1").Value) Then
　　　　Range("A1").Value = 0
　　End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim A3_Isect As Object
　　Dim B3_Isect As Object

　　If Target.Address(False, False) = "A1" Then
　　　　Exit Sub
　　End If
　　Set A3_Isect = Intersect(Target, Range("A3"))
　　If Not A3_Isect Is Nothing Then
　　　　If Range("A3").Value <> A3_Value Then
　　　　　　A3_Value = Range("A3").Value
　　　　　　Range("A1").Value = Range("A1") + 1
　　　　End If
　　End If
　　Set B3_Isect = Intersect(Target, Range("B3"))
　　If Not B3_Isect Is Nothing Then
　　　　If Range("B3").Value <> B3_Value Then
　　　　　　B3_Value = Range("B3").Value
　　　　　　Range("A1").Value = Range("A1") + 1
　　　　End If
　　End If
　　If A3_Value = 0 And B3_Value = 0 Then
　　　　Range("A1").Value = 0
　　End If

End Sub

なお、このコードだと、A3とB3を両方選択して、入力後に[Ctrl]を押しながら[Enter]で一度に元の値と異なる値を入力すると、A1は＋2されます。