[VBAマクロ] Private Sub

質問

以下のコードは、ある任意のテーブルの最終行に何か入力すると自動的に新しい行を追加します。（例えば、TotalVal をセルR5に名前定義して、4行目に何か入力するとマクロが走って5行目に新規の行が挿入されます。）

新規の行を入力するだけでなく、直前行の計算式とフォーマット形式もコピーして行の挿入をするにはどうしたらよいか、どなたかご教示していただけませんでしょうか。よろしくお願います。

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = [TotalVal].Row - 1 Then
Application.EnableEvents = False
[TotalVal].EntireRow.Insert
Application.EnableEvents = True

End If

End Sub

回答No.3

WindFaller

こんにちは。

すみません。今の内容だけでは、何か足らない気がしています。
本日は、完成しませんし、明日はお応えできるか分かりません。

>4行目にいろんな式や入力規制とかあってそれをそのまま5行目にコピーして、
>それ以降は新規行が挿入されるたびにその直前一行前をコピーして新規行に貼り付けというのをやりたいのです……

これまでに、分かったことをまとめますと、
----------------------------------
表の計算は、テーブル内で行われていること。
「TotalVa」 の名前登録の「R5」というのは、R1C1型の5行目ということ。
4行目に数式(SUM関数)や入力規則があること。
「計算式を含む行とそれ以前を挿入する」と、R1からR4の合計のSUM関数の計算がずれること。
SUM関数の後の新規の行が挿入されたら、直前一行前をコピーして新規行に貼り付けすること。
(つまり、SUM関数はコピーはしないから、SUM関数の次の次の行からイベント・ドリブン型のマクロが起動する)
-----------------------------------------
ここまでは、良ろしいのでしょうか？

最大の問題点は、Worksheet_Changeのイベント・ドリブン型ですから、入力のたびにマクロが走ってしまうこと。
4行目に挿入したら、数式等は、5行目に移ります。
行が挿入されたら、数式などが下に移動するだけです。それ自体をコピーをする必要などはありません。
実際、SUM関数などをコピーしたら、二重の計算になって意味を持ちません。

>それ以降は
もう一つは、名前定義の「TotalVal」の存在です。これ自体は、ワークシートに属するものですから、マクロでは確実な把握はできません。
挿入はともかく、削除したりすれば、マクロがエラーになってしまいます。

------------------------
試験段階としては、Calculate イベントで考えてみました。ただ、Calculateイベントは、ワークブック全体に走るイベントですから、シートのみにするために、施してあります。実用度はかなり低いものだと思っています。また、名前定義はなくなる可能性があるので、そのチェック項目を付けました。もともと、何かの値を入れて、挿入を繰り返すというのは、そのテーブルをいじることが出来ないのではないか、と思いました。本日は、ここまでといたします。
少し、日にちが空くかもしれませんが、ご容赦のほどをお願いします。できたら、私の疑問点にお応えください。

'//
Private Sub Worksheet_Calculate()
　Dim rng As Range
　Dim i As Long
　Dim num As Long
　On Error Resume Next
　i = Range("TotalVal").Row '名前登録のチェック
　num = Err.Number
　On Error GoTo 0
　If ActiveCell.Parent.Parent.Name <> ThisWorkbook.Name Then Exit Sub
　If Intersect(ActiveCell, Me.ListObjects(1).Range) Is Nothing Then Exit Sub
　Set rng = Intersect(ActiveCell.EntireRow, Me.ListObjects(1).Range)
　If rng.Cells(1).Offset(1).HasFormula = True Then
　　With rng.Cells(1).Offset(1)
　　　If InStr(1, .FormulaLocal, "=SUM", vbTextCompare) > 0 Then
　　　　Application.EnableEvents = False
　　　　For Each c In .Rows.Cells
　　　　　c.FormulaLocal = "=SUM(R1C:R[-1]C)"
　　　　Next
　　　End If
　　End With
　　On Error Resume Next
　　　With Me.ListObjects(1).Range
　　　Application.EnableEvents = False
　　　　.Rows(rng.Row - 1).Copy
　　　　.Rows(rng.Row).PasteSpecial Paste:=11
　　　End With
　　　Application.CutCopyMode = False
　　 On Error GoTo 0
　ElseIf num = 0 Then
　　If rng.Row > i And _
　　　rng.Rows.Cells(1).Value = "" Then
　　　Application.EnableEvents = False
　　　On Error Resume Next
　　　With Me.ListObjects(1).Range
　　　　.Rows(rng.Row - 1).Copy
　　　　.Rows(rng.Row).PasteSpecial Paste:=11
　　　End With
　　　Application.CutCopyMode = False
　　　On Error GoTo 0
　　　Application.EnableEvents = True
　　End If
　 Else
　　 If num > 0 Then
　　　 MsgBox "名前登録'TotalVal' は壊れています。", 16
　　 ElseIf Intersect(Range("TotalVal"), Me.ListObjects(1).Range) Is Nothing Then
　　　 MsgBox "名前登録'TotalVal' はテーブルの範囲外にあります。", 16
　　 End If
　End If
　i = 0
　Application.EnableEvents = True
End Sub
'//

回答No.2

WindFaller

こんにちは。

また、もしかしてなのですが、
>R5にはsum計算式があり、R1からR4の合計
それは、R1C1方式なのではありませんか？

その場合は、R5の数式は、=SUM(R1C:R5C)ではなく、相対参照式で、
=SUM(R[-5]C:R[-1]C)
にすれば、数式は、挿入しても、そのまま生きているはずです。
(R[-5]は、R1の部分に、項目名が入っていない場合です。)

補足

ありがとうございます。

4行目にいろんな式や入力規制とかあってそれをそのまま5行目にコピーして、それ以降は新規行が挿入されるたびにその直前一行前をコ
ピーして新規行に貼り付けというのをやりたいのですが、どうしたらよいのでしょうか？

よろしくお願います。

回答No.1

WindFaller

こんにちは。

もしかしてですが、
>任意のテーブルの最終行に何か入力すると自動的に新しい行を追加します。
この仕様をテーブル全体にしたいということでしょうか？それとも、4行目に対してのみですか？

>TotalVal をセルR5に名前定義して

これ自体、なぜ名前定義をしているのかよく分からないのですが、今のコードですと、4行目の対象セルが下にズレていくようです。

補足

お返事ありがとうございます。
R5にはsum計算式があり、R1からR4の合計が計算されています。行を挿入する度にsum計算式がズレて常にR1から直前行の合計が見えるようにしたいのです。