集計方法を教えてください！

質問

凸社のポイント数をポイント毎にA1に入力し、合計をＢ1に表示させたいのですが！
毎回同じセルに数値を入力し別のセルに合計を出す方法を教えてください！！

回答No.4

nishi6

対象範囲をA1:C10にして、undo可能にしてみました。今は7回(任意に指定できます)

○ThisWorkbookに貼り付けます。
'A1:C10に入力された数値をD1:F10に加算し続ける。undo可能。
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count <> 1 Then Exit Sub
If Union(Range("A1:C10"), Target).Address <> "$A$1:$C$10" Then Exit Sub
If IsNumeric(Target) = False Then Exit Sub
Application.EnableEvents = False
Target.Offset(0, 3) = Val(Target.Offset(0, 3)) + Target
If undoFlg = False Then 'undoでない時は入力を記憶
rw = Target.Row
cl = Target.Column
If idx(rw, cl) < undoNum Then 'undo最大回数前
idx(rw, cl) = idx(rw, cl) + 1
iDT(rw, cl, idx(rw, cl)) = Val(Target)
Else 'undo最大回数以上になった
For ct = 2 To undoNum '記憶した入力をずらす
iDT(rw, cl, ct - 1) = iDT(rw, cl, ct)
Next
idx(rw, cl) = undoNum
iDT(rw, cl, idx(rw, cl)) = Val(Target)
End If
End If
Application.EnableEvents = True
End Sub

○Ｓheet1(例えば)に貼り付けます。
'undo。コントロールツールボックスのボタンを配置
Private Sub CommandButton1_Click()
rw = ActiveCell.Row '行
cl = ActiveCell.Column '列
If ActiveCell.Count <> 1 Then Exit Sub
If Union(Range("A1:C10"), ActiveCell).Address <> "$A$1:$C$10" Then
Cells(rw, cl).Select: Exit Sub
End If
If idx(rw, cl) = 0 Then
MsgBox "undoできません。": Cells(rw, cl).Select: Exit Sub
End If
If MsgBox(idx(rw, cl) & " 回 undoできます。", vbOKCancel) = vbCancel Then
Cells(rw, cl).Select: Exit Sub
End If
'undo
undoFlg = True
Cells(rw, cl) = -iDT(rw, cl, idx(rw, cl))
Cells(rw, cl) = -iDT(rw, cl, idx(rw, cl) - 1)
Cells(rw, cl) = iDT(rw, cl, idx(rw, cl) - 1)
undoFlg = False
iDT(rw, cl, idx(rw, cl)) = 0
idx(rw, cl) = idx(rw, cl) - 1
Cells(rw, cl).Select
End Sub

Sub EventsFukki()
Application.EnableEvents = True
End Sub

○標準モジュールに貼り付けます。
Public iDT(10, 3, 7) As Long '入力値。3つ目の7はundo最大回数
Public idx(10, 3) '入力個数。行と列個数分
Public rw, cl As Integer '行、列
Public ct As Integer 'カウンタ
Public undoFlg As Boolean 'undoの時True
Public Const undoNum = 7 'undo最大回数

回答No.3

april21

Ａ1ではなく電卓を使うのはどうでしょうか？
クイック起動に電卓のショートカットを入れておけば直ぐに起動することが出来ますし合計は「編集」-「コピー」でコピーしてセルに貼り付けることが出来ます。

クイック起動は「スタート」ボタンの右隣にアイコンが表示された領域のことです。

回答No.2

nishi6

A1に入れるとB1に加算します。通常の方法では期待薄なのでマクロを書いてみました。A1に入力後Enterでセルが動かないようにしていたほうがいいですね。

ツール→マクロ→Visual Basic EditorでVBE画面に移って
表示→プロジェクトエクスプローラでプロジェクトエクスプローラ画面を出して、ThisWorkbookをダブルクリックして、開いたコードウインドウに下記コードを貼り付けます。
シートに戻って、A1に入力するとそれをB1に加算し続けます。
入力チェックはしていますが、何が起きるか分かりませんので、エラーが起きて、B1に加算しなくなったらEventsFukkiを動かしてください。元に戻ります。

'A1に入力された数値をB1に加算し続ける
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub 'A1のみ
If IsNumeric(Target) = False Then Exit Sub '数値のみ
Application.EnableEvents = False 'イベントを止める
Range("B1") = Val(Range("B1")) + Target '加算
Application.EnableEvents = True 'イベントを可に
End Sub

'何かのエラーで加算しなくなったらこれを動かす。イベントを起こす
Sub EventsFukki()
Application.EnableEvents = True
End Sub

お礼

早速の回答ありがとうございます。上手くいきました。もしA1に入力ミスをした場合、１つ前若しくは２つ前に戻るアンドゥ機能もVBAで可能でしょうか？
今回は範囲がA1に入力なんですがA1:C10に入力したのをD1:F10に加算するといった場合にはなにか方法ありますでしょうか？

回答No.1

inoue64

Excelの場合、VBAというプログラム言語で
プログラムを組む必要があると思います。