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

A 回答 (4件)

対象範囲を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

○Sheet1(例えば)に貼り付けます。
'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最大回数
    • good
    • 0

A1ではなく電卓を使うのはどうでしょうか?


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

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

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
    • good
    • 0
この回答へのお礼

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

お礼日時:2001/06/23 00:48

Excelの場合、VBAというプログラム言語で


プログラムを組む必要があると思います。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード


人気Q&Aランキング

おすすめ情報