-PR-
締切り
済み

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

  • すぐに回答を!
  • 質問No.94207
  • 閲覧数47
  • ありがとう数1
  • 気になる数0
  • 回答数4
  • コメント数0

お礼率 25% (1/4)

凸社のポイント数をポイント毎にA1に入力し、合計をB1に表示させたいのですが!
毎回同じセルに数値を入力し別のセルに合計を出す方法を教えてください!!
通報する
  • 回答数4
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

回答 (全4件)

  • 回答No.1
レベル13

ベストアンサー率 29% (334/1115)

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


  • 回答No.2
レベル13

ベストアンサー率 68% (791/1163)

A1に入れるとB1に加算します。通常の方法では期待薄なのでマクロを書いてみました。A1に入力後Enterでセルが動かないようにしていたほうがいいですね。 ツール→マクロ→Visual Basic EditorでVBE画面に移って 表示→プロジェクトエクスプローラでプロジェクトエクスプローラ画面を出して、ThisWorkbookをダブルクリックして、開いたコードウインドウに下記コードを貼り付けます。 ...続きを読む
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
お礼コメント
pontinton

お礼率 25% (1/4)

早速の回答ありがとうございます。上手くいきました。もしA1に入力ミスをした場合、1つ前若しくは2つ前に戻るアンドゥ機能もVBAで可能でしょうか?
今回は範囲がA1に入力なんですがA1:C10に入力したのをD1:F10に加算するといった場合にはなにか方法ありますでしょうか?
投稿日時 - 2001-06-23 00:48:47
  • 回答No.3
レベル11

ベストアンサー率 42% (91/216)

A1ではなく電卓を使うのはどうでしょうか? クイック起動に電卓のショートカットを入れておけば直ぐに起動することが出来ますし合計は「編集」-「コピー」でコピーしてセルに貼り付けることが出来ます。 クイック起動は「スタート」ボタンの右隣にアイコンが表示された領域のことです。
A1ではなく電卓を使うのはどうでしょうか?
クイック起動に電卓のショートカットを入れておけば直ぐに起動することが出来ますし合計は「編集」-「コピー」でコピーしてセルに貼り付けることが出来ます。

クイック起動は「スタート」ボタンの右隣にアイコンが表示された領域のことです。
  • 回答No.4
レベル13

ベストアンサー率 68% (791/1163)

対象範囲をA1:C10にして、undo可能にしてみました。今は7回(任意に指定できます) ○ThisWorkbookに貼り付けます。 'A1:C10に入力された数値をD1:F10に加算し続ける。undo可能。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Targe ...続きを読む
対象範囲を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最大回数
このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
このやり方知ってる!同じこと困ったことある。経験を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ