Excelのカウントアップボタンについて

エクセルで統計を取ろうと思い、クリックすると数字が増えるカウントアップボタンをD～K列それぞれ50セル、合計400セルに取り付けようと思うのですが、

自分の調べた方法ですととても面倒な作業になってしまうので、
もし簡略化できる方がいらっしゃいましたら教えて頂けませんでしょうか。

自分の調べた方法

Sub ボタンD4_Click()
Range("D4") = Range("D4") + 1
End Sub

上記のようなマクロを400個作り、それぞれのボタンに当てはめていく。

ボタンはそれぞれ数値の増やしたいセル上に配置しています。

オートフィルで簡単に増やせれば理想です。宜しくお願いします。

No.1 ベストアンサー 回答者： KenKen_SP 回答日時： 2008/05/15 19:00

こんばんは。

Application.Caller と TopLeftCell を組み合わせれば、プロシージャは
ひとつで済みそうですよ。

簡単なサンプルです。

ボタンは、カウントアップするセル内に配置し、その他のセルにまたがら
ないようにします。あとは、マクロの割り当てをし、フィルでコピー。

' // 標準モジュール
Sub CountUp()

　　Dim r As Range
　　
　　On Error Resume Next
　　Set r = ActiveSheet.Shapes(Application.Caller).TopLeftCell
　　On Error GoTo 0
　　
　　If Not r Is Nothing Then
　　　　r.Value = r.Value + 1
　　End If
　　
　　Set r = Nothing

End Sub

この回答へのお礼

完璧です！理想通りです！！
本当にありがとうございました。
こういうのは本で学ぶのでしょうか・・・？

お礼日時：2008/05/16 02:02

No.2 回答者： merlionXX 回答日時： 2008/05/15 23:21

ボタンによる方法はすでに回答がでていますので、ボタンを使わないやり方を・・・・。

加算したいセルをダブルクリックすればカウントアップします。

仮にD1:K50が対象範囲なら、当該シートのシートモジュール（シートタブを右クリックしてコードの表示で出てきます。）に

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("D1:K50")) Is Nothing Then Exit Sub
Target.Value = Target.Value + 1
Cancel = True
End Sub

としてみてください。

この回答へのお礼

ありがとうございます！！
こんな事も可能なのですね！
これは今まで作ったブックに使えそうです！

お礼日時：2008/05/16 02:04