エクセルのマクロコードについて

質問

エクセルのマクロコードに付いて教えて下さい。 下記のマクロコードがありますが、

Option Explicit
'
Private Sub Worksheet_Change(ByVal Target As Range)
'
　　Static Memo(1 To 3) As Long
　　Dim Cell As Range
'
　　If Intersect([A1:C1], Target) Is Nothing Then
　　　　Exit Sub
　　End If
'
　　For Each Cell In Target
'
　　　　If Cell = "" Then
　　　　　　Memo(Cell.Column) = 0
　　　　End If
　　Next Cell
　　Set Cell = Target(1)
'
　　If Not IsNumeric(Cell) Or Cell = "" Then
　　　　Exit Sub
　　End If
'
　　Application.EnableEvents = False
　　Memo(Cell.Column) = Memo(Cell.Column) + Target
　　Target = Memo(Cell.Column)
　　Application.EnableEvents = True
End Sub

セル位置の指定を変更する場合は、どの様に書けば良いのですか？
このコードですと、セルＡ1からc1の入力指定でなっていますが
Ａ1からAA1までとかにする場合やA1の結果を、A1ではなくA2に表示Ｂ1の結果をＢ2に表示する場合はどのように書くのでしょうか？

マクロに付いて、殆ど知識が無いものですので
出来れば、分かり易い説明でお願いします。

宜しくお願いします。

回答No.4

HohoPapa · ベストアンサー

◆まず、承知かもしれませんが、提示されたマクロ動作は以下です。

指定範囲のセル（[A1:C1]）の数だけ、
セルに対応する作業用の変数を用意し
この変数のブック起動時の初期値をゼロにする。
　　Static Memo(1 To 3) As Long

指定範囲のセル（[A1:C1]）以外が書き換わった場合は、
（書き換わったセルが指定範囲に含まれていなかったら）
何もしないで抜ける
　　If Intersect([A1:C1], Target) Is Nothing Then
　　　　Exit Sub
　　End If

指定範囲のセル（[A1:C1]）に空欄が埋まったら、あるいは埋まっていたら
セルに紐づいた作業用変数にゼロをセットする。、
　　For Each Cell In Target
　　　　If Cell = "" Then
　　　　　　Memo(Cell.Column) = 0
　　　　End If
　　Next Cell

書き換わったセルに文字、または空欄が埋まった場合は抜ける
　　If Not IsNumeric(Cell) Or Cell = "" Then
　　　　Exit Sub
　　End If

書き換わったセルに紐づいた作業用変数に
セルに埋まった値を加算する。、
　　Memo(Cell.Column) = Memo(Cell.Column) + Target

書き換わったセルに、セルに紐づいた作業用変数を埋める
　　Target = Memo(Cell.Column)

◆続いて、
> Ａ1からAA1までとかにする場合

対象範囲を
　　If Intersect([A1:C1], Target) Is Nothing Then
の
[A1:C1]
ここで定義していますから、ここを
　　If Intersect([A1:AA1], Target) Is Nothing Then
と書き換え、

さらに
書き換わったセルに紐づいた作業用変数を
　　Static Memo(1 To 3) As Long
で定義していますので、これを
　　Static Memo(1 To 27) As Long
と書き換えます。

◆更に
>A1の結果を、A1ではなくA2に表示Ｂ1の結果をＢ2に表示する場合

書き換えるセルと加算後の値を表示するセルが異なる場合は
上記で説明したような面倒なことは必要なく
以下のようなコードで実現できます。

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect([A1:C2], Target) Is Nothing Then
Exit Sub
End If

If ((Not IsNumeric(Target)) Or (Target = "")) Then Exit Sub

Application.EnableEvents = False
If Target.Value = 0 Then
Target.Offset(1, 0).Value = 0
Else
Target.Offset(1, 0).Cells.Value = _
Target.Offset(1, 0).Cells.Value + Target.Value
End If
Application.EnableEvents = True

End Sub

◆おまけ
書き換えたセル自身に加算する。
かつ、この範囲を複数列、複数行にしたい場合は

Private Sub Worksheet_Change(ByVal Target As Range)

Static Memo(1 To 3, 1 To 2) As Long　'3列2行の意味です。
Dim Cell As Range

If Intersect([A1:C2], Target) Is Nothing Then
Exit Sub
End If

For Each Cell In Target
If Cell = "" Then
Memo(Cell.Row, Cell.Column) = 0
End If
Next Cell

Set Cell = Target(1)

If Not IsNumeric(Cell) Or Cell = "" Then
Exit Sub
End If

Application.EnableEvents = False
Memo(Cell.Row, Cell.Column) = Memo(Cell.Row, Cell.Column) + Target
Target = Memo(Cell.Row, Cell.Column)
Application.EnableEvents = True

End Sub

◆最後に

セルに入力すると加算していく上記仕様は
ブックの起動に戻ると、
セルに対応する作業用の変数がゼロになりますので
これを回避する場合は、別途手当てが必要です。

今回説明していない行は
自身でインターネットを漁ってみてください。
情報はゴロゴロころがっています。

なお、私だったら、Formを使います。

お礼

ありがとうございます。
これを機会にしっかり勉強します。

回答No.5

HohoPapa

ごめんなさい、おまけ部分を訂正します。

◆おまけ
書き換えたセル自身に加算する。
かつ、この範囲を複数列、複数行にしたい場合は

Private Sub Worksheet_Change(ByVal Target As Range)

Static Memo(1 To 3, 1 To 2) As Long　'3行2列の意味です。
Dim Cell As Range

If Intersect([A1:B3], Target) Is Nothing Then
Exit Sub
End If

For Each Cell In Target
If Cell = "" Then
Memo(Cell.Row, Cell.Column) = 0
End If
Next Cell

Set Cell = Target(1)

If Not IsNumeric(Cell) Or Cell = "" Then
Exit Sub
End If

Application.EnableEvents = False
Memo(Cell.Row, Cell.Column) = Memo(Cell.Row, Cell.Column) + Target
Target = Memo(Cell.Row, Cell.Column)
Application.EnableEvents = True

End Sub

お礼

詳しい解説ありがとうごさいます。
とても勉強になりました。
今回をきっかけに勉強をしてみます。

回答No.3

kkkkkm

Static Memo(1 To 3) As Long
を
Static Memo(1 To 27) As Long

　　If Intersect([A1:C1], Target) Is Nothing Then
を
If Intersect(Range("A1:AA1"), Target) Is Nothing Then

Target = Memo(Cell.Column)
を
Target.Offset(1, 0).Value = Memo(Cell.Column)

それぞれ変更してください。

入力したA列の値をどのようにするのか不明ですので入力した値のままです。

お礼

ありがとうございます。
とても勉強になりました。
今回を機会に勉強してみようと思います。

回答No.2

SI299792

一度に２つ質問しないでください。回答がややこしくなります。

A1からAA1 までとかにする場合
Option Explicit
'
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim Save As Variant
'
　　If Target.Count > 1 Or Intersect(Target, [A1:AA1]) Is Nothing Then
　　ElseIf Target > "" Then
　　　　Save = Target
　　　　Application.EnableEvents = False
　　　　Application.Undo
　　　　On Error Resume Next
　　　　Target = Target + Save
　　　　On Error GoTo 0
　　　　Application.EnableEvents = True
　　End If
End Sub

A1ではなくA2に表示B1の結果をB2に表示する場合
'
Private Sub Worksheet_Change(ByVal Target As Range)
'
　　If Target.Count = 1 And Not Intersect(Target, [A1:AA1]) Is Nothing Then
　　　　Application.EnableEvents = False
　　　　On Error Resume Next
　　　　Target.Offset(1) = Target.Offset(1) + Target
　　　　On Error GoTo 0
　　　　Application.EnableEvents = True
　　End If
End Sub

お礼

ありがとうございます。
勉強になりました。

回答No.1

chie65536（@chie65535）

＞マクロに付いて、殆ど知識が無いものですので

であれば、改変は無理でしょう。

ご質問のマクロでは「対象セルのカラム位置が、A、B、Cだけである事」とか、対象が固定されている事を前提にしている部分が沢山あります。

例えば「Memo(Cell.Column)」の部分。この部分は、対象がA列、B列、C列じゃない場合、エラーが起きます。

また、対象がA1～A3など、縦に並んでいる場合「Cell.Column」は「最初から最後まで、ずっと1のまま」なので、思った通りには動きません。

＞出来れば、分かり易い説明でお願いします。

同等の説明を、EXCELマクロの有料講習で行ったなら、時間5000円で、３～４時間かかります。同等の説明をここで行うのは不可能です。

最低限「こういう動作にしたくて、自分でこういうふうに改造してみたが、エラーが出る。どう直せば良いか？」レベルの質問じゃないと回答できません。

お礼

ありがとうございます。