[[20170829155800]]　『同一セルに入力して累積表示させたい（複数のセル』（勇者おひょい）　ページの最後に飛ぶ

『同一セルに入力して累積表示させたい（複数のセル）　マクロ』（勇者おひょい）

お世話になります。
エクセルのセルに数字を入力したあと、もう一度同じセルに数字を入力すると累積されるようにしたいのです。
それを、Ｃ５～Ｐ９６まですべてそれぞれのセルごとに累積できるようにしたいのですが、何か方法があるのでしょうか。
ご教示よろしくお願いします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 マクロにすれば出来ないことはありませんが、やめたほうがよいと思います。
 入力を別のセルにして、表示させたいセルは計算式で求めるなど、やり方を変えることはできませんか？
（稲葉） 2017/08/29(火) 16:35

コメントありがとうございます。
他のサイト等でも検索しましたが修正が難しい（出来ない）等いろいろご指摘がありました。
ですが今回の作成に当たり累積する方法が浅はかな自分ではその方法がベストだと思いました。
どうか、コードの記述をご教示くださいます様よろしくお願いします。

（勇者おひょい） 2017/08/29(火) 16:53

 分かりました。
 ちょっと作ってみますが、

 この
 ＞ですが今回の作成に当たり累積する方法が浅はかな自分ではその方法がベストだと思いました。 
 背景というか、「なぜそのようなやり方で累積しなければいけないのか」を教えて頂けますか？

（稲葉） 2017/08/29(火) 16:56

ご回答ありがとうございます。
現在販売業務に携わっておりまして、出荷量を集計するにあたり日付別、市場別にわたり多数の出荷数が同名、同日で複数記述されることが多々あります。そこで別シートにて生産者別・市場別・日付別にてマクロ記録にて作成したのですが縦横に非常に広がってしまい入力が煩雑になってしまい、また入力ミス（セルの番地違い）も多く散見されました。　そこで同一セルにて累積することによってコンパクトなシートを作成できればと思い投稿させていただきました。また合計数量は事前に日付別（別業者）で集計されている為、万一数量が合わない時、ミスを検索するのも比較的容易だろうと判断しました。
上記の事から累積マクロを作成していただきたくお願い申し上げます。
乱文で申し訳ありません。
Ps　他のサイトでも同一セルに入力して合計のようなものがありましたが単一セルのみの使用であったため今回こちらに投稿させていただきました。
（勇者おひょい） 2017/08/29(火) 17:15

Sheet2を前回値として使う例なぞ。 Sheet1のシートモジュールとして、以下を貼りつけてください。

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim R As Range

    If Intersect(Target, Range("C5:P96")) Is Nothing Then Exit Sub

    Application.EnableEvents = False
    For Each R In Intersect(Target, Range("C5:P96"))
        With Sheets("Sheet2").Range(R.Address)
            If IsNumeric(R.Value) = True Then
                .Value = .Value + R.Value
                R.Value = .Value
            Else
                .Value = ""
            End If
        End With
    Next R
    Application.EnableEvents = True
 End Sub

しかしながら、このマクロによる解決は、決してお薦めしません。それは、もし入力ミスがあっても、いつ間違えたのか全く判らないから。同じセルが加算されれば、ミスの検索が容易？いえいえ、全く逆で、ミスの検索が不可能になると思いますよ。

例えば、利用者は入力した値が勝手に変わったら、自分が打ち間違えたと思って、同じ値をまた入力する事でしょう。すると、更に加算されていって、意味不明な値になってしまうでしょう。誰が間違えたか、元は幾つだったのか、どうやれば判りますか？
（???） 2017/08/29(火) 17:31
（17:46 セル範囲指定を追加）
（17:56 文字列入力された場合は累積リセットするよう処理追加）

 そうすると、累計させたいシートは複数・・・？
 今回は1ブック1シートを想定して記述いたしましたが、用が足りないかもしれませんね。

 事前準備
 １）シートを新しく作り「バックアップ」という名前にしてください。
 ２）コード中、★印のシート名を累計したいシート名に変更してください。
 ３）Thisworkbookモジュールとシートモジュールにコードが分かれていますので、各々指定の場所に貼り付けてください。

 理由を読んだ所感ですが、フォームを利用されたほうがミスが無くていいのかなと。
 今回のコードはUnDo（戻る）が使用できません。
 C5に1を入力、次に5と入力したが、間違いで、元に戻したいが戻せません。
 やってみて難しいことを実感してください。

    'ThisWorkbookモジュールに記入

    Option Explicit
    Const pass As String = "1234"
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
        With Sheets("元シート") '★
            .Visible = False
            Sheets("バックアップ").Visible = False
            ThisWorkbook.Protect pass, True
            Application.EnableEvents = False
            ThisWorkbook.Save
            Application.EnableEvents = True
            If MsgBox("作業を続けますか？", vbYesNo) = vbYes Then
                ThisWorkbook.Unprotect pass
                .Visible = True
                .Activate
            Else
                ThisWorkbook.Close False
            End If
        End With
    End Sub

    Private Sub Workbook_Open()
        ThisWorkbook.Unprotect pass
        With Sheets("元シート") '★
            .Visible = True
            .Activate
            Sheets("バックアップ").Range("C5:P96").Value = .Range("C5:P96").Value
            Sheets("バックアップ").Visible = False
        End With
    End Sub

    '累計を行いたいシートのシートモジュールに記入
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim ws As Worksheet
        Dim msg As String
        Set ws = Sheets("バックアップ")
        If Not Intersect(Target, Range("C5:P96")) Is Nothing Then
            Select Case True
                Case Target.CountLarge > 1:        msg = "変更は1セルずつ行ってください。変更されたデータを元に戻します。"
                Case Not IsNumeric(Target.Value):  msg = "数値以外が入力されました。数値を入力してください"
                Case Else:                         msg = ""
            End Select
            Application.EnableEvents = False
            If msg <> "" Then
                MsgBox msg
                Range("C5:P96").Value = ws.Range("C5:P96").Value
            Else
                Target.Value = Target.Value + ws.Range(Target.Address).Value
                ws.Range(Target.Address).Value = Target.Value
            End If
            Application.EnableEvents = True
        End If
    End Sub
（稲葉） 2017/08/29(火) 17:36

早々とご回答ありがとうございます。
おっしゃる通りフォームにて入力も考えました。
もちろんその方がミスも少なくわかりやすいだろうと思いましたが、入力速度を考えた時累積の方がはやいのかなぁと思い今回に至りました（ミスばかりで修正が困難になってしまっては本末転倒ですが・・・）
入力の件ですが、１シートですべての入力を完結させて別シートに請求書・稟議書・保管料などをリンクさせていくつもりです。
ですので冒頭で記述させていただいたＣ５～Ｐ９６まで累積換算させてＡ、Ｂ列は市場別・生産者　３、４行目は日付別・品種として９７行及びＱ列についてはＳＵＭＩＦで簡単に算出したいと考えます。
もっと他にシンプルな方法があるとは思いますが、今後の勉強のためにもよろしくお願いいたします。
なお、小生今現在エクセルが近くにない環境であるため検証は後日になりますが、親切丁寧にご教示くださりまことに感謝いたします。
（勇者おひょい） 2017/08/29(火) 18:44

 １）集計後の結果表
 ２）入力する項目
 ３）入力頻度
 これらを提示いただければ、一度入力表を作ってみますがどうしますか？
[[20110209184943]]　『[談]シートレイアウトの投稿どうしてますか？』（ｍｏｍｏ）　>>BOT
 結果表はこちらのツール（Win10　2016で使えるのかなぁ・・・）で簡単に貼り付け形式に出来ると思います。
（稲葉） 2017/08/29(火) 19:07

稲葉様

1.集計後の結果表とは上記で言う請求書・稟議書・保管料でよろしいのでしょうか？
　http://fast-uploader.com/file/7059717274901/　集計表
　http://fast-uploader.com/file/7059717305443/　請求書
　http://fast-uploader.com/file/7059717333827/　稟議書
　http://fast-uploader.com/file/7059717343599/　保管料
2.入力する項目は　日付・生産者No（氏名が表示される）・市場・品種・数量です。
3.入力頻度は日別で800回程度です。

返信が遅くなり申し訳ありませんでした。

（勇者おひょい） 2017/08/31(木) 15:54

 すみませんが、ファイルはダウンロードできません。

（稲葉） 2017/09/01(金) 08:56

コメント返信：

[ 一覧(最新更新順) ]

[[20170829155800]] 『同一セルに入力して累積表示させたい（複数のセル』（勇者おひょい） ページの最後に飛ぶ

[[20170829155800]]　『同一セルに入力して累積表示させたい（複数のセル』（勇者おひょい）　ページの最後に飛ぶ