「ブロック機能」のリニューアルについて

おせわになります
仕事で材料の集計を行っています
図面から拾って電卓で打って入力していましたが手間と時間がかかって捗りません。
そこでお尋ねしたいのですが添付画像のH列(H5からH19)複数のセルに任意の数字を上書き入力したらそのセルに累積表示するようにしたい。
教えて!gooを検索していましたら2006年のmerlionXXさんの次のような回答がありました。
このコードを改造して複数セルに対応できるようにすることは可能でしょうか?
コードは↓のとおりです。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$H$5" Then Exit Sub
x = Target.Value
With Application
.ScreenUpdating = False
.EnableEvents = False
.Undo
y = Target.Value
Target.Value = x + y
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

どなたかご教示お願い致します。

「エクセルで、同じセルに数値を上書きで入力」の質問画像
教えて!goo グレード

A 回答 (3件)

こんばんは、


VBAを使用するのなら集計方法自体を別法で行った方が良いように思います
・・紙ベースなのかもしれませんが、集計表に入力せずに他の列やシートに入力するとかコピーするとかで 最後にVBAで結果を集計とかで・・

折角苦労してコードを見つけたのでしょうから、課題は残ると思いますが
開発が目的ではないと思いますので添削サンプルです 電卓よりは良いのかも知れません
取り合えずの仕様
基本的にアクティブセルが対象です。
クリアーするとコードは実行されずクリアーされます。
従って複数セルをクリアー出来ますが、戻る操作で復元できるのは単セルのみです。
複数選択でタブキーなどの操作も出来ますが、コピペなどはアクティブセルのみ反映されると思います

殆ど変えていないのでわからない所は調べてくださいね

Private Sub Worksheet_Change(ByVal Target As Range)
If Target(1).Value = "" Then Exit Sub
If Intersect(Target(1), Range("H5:H19")) Is Nothing Then Exit Sub
Dim x, y
x = Target(1).Value
With Application
.ScreenUpdating = False
.EnableEvents = False
.Undo
y = Target(1).Value
Target(1).Value = x + y
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございました
早速使っています
お陰様で期限内に納めることが出来ました
本当にありがとうございました

お礼日時:2022/08/13 14:59

fujillin さんのご指摘されているケースを踏まえてVBAコードを組んでみました。

第8列(H列)の入力で既存値に加算、複数セルのコピペ、削除のケース、複数セルの削除に対応しています。(コードに冗長なところがありますが急ごしらえなのでお許しください。)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Integer ' 変更のあったセルの列番号
Dim r As Integer ' 変更のあったセルの行番号
Dim newV As Variant ' 新しい入力値
Dim oldV As Variant ' 古い値
Dim nV As Variant ' new value
Dim oV As Variant ' old value
Dim T As Variant ' 繰り返し処理の変数(eachで使用)
Dim i, n ' 一時的な変数

c = Target.Column
r = Target.Row
' 変更されたセルの数(複数セルのコピペ)
n = Target.Count
ReDim newV(n - 1)
ReDim oldV(n - 1)
' 変更のあった列のチェック
If c <> 8 And r > 4 Then Exit Sub
 With Application
 .ScreenUpdating = False
 .EnableEvents = False
 ' get new value
 nV = Target.Value
 If Not IsEmpty(nV) Then
 .Undo
 ' get old value
 oV = Target.Value
 If n > 1 Then
 i = 1
 For Each T In Target
 newV = nV(i, 1)
 With ActiveSheet
 oldV = oV(i, 1)
 If Not IsEmpty(newV) Then
 .Cells(T.Row, c) = newV + oldV
 Else
 .Cells(T.Row, c) = newV
 End If
 End With
 i = i + 1
 Next
 Else
 .Cells(r, c) = nV + oV
 End If
 End If
 .EnableEvents = True
 .ScreenUpdating = True
End With
End Sub
    • good
    • 0

こんにちは



不可能ではないと思いますけれど、使い方によってはうまく動作しないケースが考えられそうです。

例えば、「複数セルにまとめてペ―ストした場合にどうするか」やご提示のコードだと「常に累計」されるので、「一旦シート内をクリア」したい場合にどうするのか?
(H列はクリアしても、累計値が表示されます)
などに関して、どうなさりたいのかをあらかじめ考えておく方がよさそうに思います。

具体的な処理としては、ご提示のコードで「H5」セル限定でチェックしている内容を、H列(=H5セル以降)でチェックするようにして、後は同様に処理を行えばひとまず可能と思います。
    • good
    • 0

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

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

このカテゴリの人気Q&Aランキング