[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『行の追加』（はなはな）
始めまして
行の追加のマクロに関して質問させてください
B C D〜G H〜AA AB〜AG
項目 No. 結合セル 結合セル 結合セル
上記のようになっている表があります。
今5行あり6行目以降をボタンで追加できるようにしたいです。
Cには現在1〜5が入っており
行を追加した際に6〜が入るようにしたいのですがどのようにすればよいでしょうか？
コピー用の1行を用意して普段非表示にしておいて挿入する形でも問題ありません。
記録するマクロのでもうまくいかず悩んでおります。
よろしくお願いします。
＜ 使用 Excel：unknown、使用 OS：Windows10 ＞
__A___B_____C___D〜G__H〜AA__AB〜AG___ 1 項目 No. **** **** **** 2 1 結合 結合 結合 3 2 結合 結合 結合 4 3 結合 結合 結合 5 4 結合 結合 結合 6 5 結合 結合 結合 7
たとえば、↑のような場合、
(1)C列最終行を調べる (2)(1)で調べた行全体を次の行に結合セルという書式のみ貼り付ける (3)(2)の行のC列に、C列全体の最大値+1の数字を書き込む
と考えてみてはどうでしょうか
（もこな２ ） 2020/03/11(水) 14:04
返答ありがとうございます。
記録を使った場合、Cに入れている数式（一つ上のセル+2）などがうまくいきません。
又非表示を使用しているせいか、まるまる全体が挿入されて下にもう一セット同じものが出来てしまったりします。
（2）の書式のみ張り付けるというのは他に関数やもろもろ入っていても結合セルだけ張り付ける形ができるのでしょうか？
（はなはな） 2020/03/11(水) 14:20
記録を使った場合、Cに入れている数式（一つ上のセル+1）などがうまくいきません。
（はなはな） 2020/03/11(水) 14:22
Dim r As Range
Set r = Range("C" & Rows.Count).End(xlUp)
Rows(r.Row).Copy
Range("A" & r.Row + 1).PasteSpecial Paste:=xlPasteFormats
r.Offset(1).Value = r.Value + 1
Application.CutCopyMode = False
End Sub
（mm） 2020/03/11(水) 15:02
ありがとうございます
早速試してみました！
表部分は問題なく追加されました！
こちらなのですが、
A、B部分に項目的な縦との結合セルがある場合それを延長することは可能なのでしょうか？
（はなはな） 2020/03/11(水) 15:16
__A___BC_____D___F〜G__H〜AA__AB〜AG___ 1 ・ 都度入力部分の項目等 ・ 13 14 項目 No. **** **** **** 15 1 結合 結合 結合 16 2 結合 結合 結合 17 ※ ※ 3 結合 結合 結合 18 4 結合 結合 結合 19 5 結合 結合 結合
列の位置に少し変更がありました。
BC列の項目の下はセル結合されています。
ｍｍ様に教えていただいたマクロでDに変更しD〜AGまでは増やすことができました。
その際、A部分の4〜19は結合セル（中は数字）部分が解除されてしまいました。
BC部分の結合部分は下に空白のセルが増えました。
何度も申し訳ありません。
よろしくお願いいたします。
（はなはな） 2020/03/11(水) 15:29
Dim r As Range
Set r = Range("D" & Rows.Count).End(xlUp)
Rows(2).Insert
Rows(r.Row).Copy
Range("A" & r.Row + 1).PasteSpecial Paste:=xlPasteFormats
r.Offset(1).Value = r.Value + 1
Application.CutCopyMode = False
End Sub
上記のようにしてみたのですが
・A列の結合が解除される
・2回目にボタンを押すとえらーが起きる
→Range("A" & r.Row + 1).PasteSpecial Paste:=xlPasteFormats
よろしくお願いします。
（はなはな） 2020/03/11(水) 15:47
■１
２回目です。
【どのようなものが記録】され、【どのように】うまくいかない（○○になってほしいのに××になってしまうなど）のでしょうか？
■２
＞（2）の書式のみ張り付けるというのは他に関数やもろもろ入っていても結合セルだけ張り付ける形ができるのでしょうか？
手作業で↓をやってみてください。
(1)6行目全体を選んで右クリックメニューから「コピー」を選択 (2)7行目全体を選らんで右クリックメニューから「形式を選択して貼り付け」を選択 (3)「書式」を選択して「OK」をクリック。
■３
＞又非表示を使用しているせいか、
後出しの条件なので、どこがどのように非表示になっているかもうちょっと詳しく説明いただかないと状況がわかりません。
↓から、2020/03/11(水) 15:47 を読んでのコメントです
■４
＞A列の結合が解除される
A列はどのように結合されている（いた）のですか？
■５
＞・2回目にボタンを押すとえらーが起きる
＞→Range("A" & r.Row + 1).PasteSpecial Paste:=xlPasteFormats
エラーが発生しているときに、rはどのセルが格納されてますか？
そして、Range("A" & r.Row + 1)のセル（というかそのセルを含む行）って既にどこかのセルが結合されていたりしませんか？
（もこな２ ） 2020/03/11(水) 17:37
Sub 行の追加()
Dim r As Range
Set r = Range("D" & Rows.Count).End(xlUp)
Rows(r.Row).Copy
Range("A" & r.Row + 1).PasteSpecial Paste:=xlPasteFormats '貼り付け
r.Offset(1).Value = r.Value + 1
Application.CutCopyMode = False
Range("A4", "A" & r.Row + 1).Merge 'セルの結合
Range("B14", "C" & r.Row + 1).Merge 'セルの結合
Range("B14", "C" & r.Row + 1).Borders.LineStyle = xlContinuous 'セルに線を引く
End Sub
（はなはな） 2020/03/11(水) 17:44
自行をそのまま挿入して複製したあとクリアする。
Sub 実験()
With Cells(Rows.Count, "D").End(xlUp)
.EntireRow.Copy
.EntireRow.Insert Shift:=xlDown
.Resize(, 30).ClearContents
.Value = WorksheetFunction.Max(.EntireColumn) + 1
End With
End Sub
（もこな２ ） 2020/03/11(水) 18:34
ありがとうございます！！
この通りです！
ありがとうございます！
折角作っていただいたのにすみません…。
こちらは同系統の表で応用させていただきたいと思います…
出来た後にまた追加でやりたいことを言われてしまったのですが
A列でセル結合されている部分までが1グループとして
下に追加されていくそうなのです。
A4〜AG（行の追加分）が1セット
その下に同じように追加されていく
A列の結合部分にはセットの番号が数字で入っています。
例えばなのですが、
Aの結合部分を指定しているとそのグループの中で昨日と同じ動作をする
といった事は可能なのでしょうか？
（はなはな） 2020/03/12(木) 11:43
張り付ける場所は、セルを指定している場所みたいなのですが、
ちょっと自分がもらったエクセルではうまく作動しなかったです……
Sub 書式をコピーする()
Dim ws As Excel.Worksheet
Set ws = Worksheets("フォーマット")
ws.Range("A12:AG32").Copy
End Sub
（はなはな） 2020/03/12(木) 11:53
Sub 書式の貼付()
Dim s As String
s = Selection.Address
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
End Sub
これもありました…
（はなはな） 2020/03/12(木) 11:56
■７
提示されたものは、"書式"じゃなくて"コピー元のテーマを使用してすべて貼り付け"ですよ。
Sub 合体()
'あらかじめ貼付先を"選択"しておく
Worksheets("フォーマット").Range("A12:AG32").Copy
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme
End Sub
【参考】 https://www.sejuku.net/blog/69447
■７
＞Aの結合部分を指定しているとそのグループの中で昨日と同じ動作をするといった事は可能なのでしょうか？
ちょっと難しいですが可能だと思います。
ちなみに、2020/03/11(水) 18:34 に提示したコードは、【なんで】1行下ではなく、自行の位置にコピー挿入しているかわかりますか？
（もこな２ ） 2020/03/12(木) 12:42
すみません・・・。ご教授いただきありがとうございます！
＞ちなみに、2020/03/11(水) 18:34 に提示したコードは、【なんで】1行下ではなく、自行の位置にコピー挿入しているかわかりますか？
Cells(Rows.Count, "D").End(xlUp)
行全体でしたから上に参照してるからですかね？？
二つに分けてるものはちょっと勝手にいじるわけにもいかないので提案してみます。
＞ちょっと難しいですが可能だと思います。
結合セルから一番下を出してって感じで検索してみます
（はなはな） 2020/03/12(木) 13:13
Cells(Rows.Count, 1).End(xlUp).Offset(2).Select
Worksheets("フォーマット").Range("A12:AG32").Copy
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme
End Sub
先ほどの2個に分かれてしまっている部分のものはこれで提案してみようと思います。
（はなはな） 2020/03/12(木) 13:29
Sub 位置()
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(-1, 3).Select
End Sub
これで使いたいセットのD列の一番下のセルを選択することはできたのですが
セルのある行を選択してコピー、挿入、数字を変えるの作業に入る時にコピーの段階でエラーになってしまいます。
Cells(Rows.Count, "D").End(xlUp)
この部分の代わりにできればと思っているのですが、どのように置き換えたらいいのでしょうか？
（はなはな） 2020/03/12(木) 15:28
■９
＞行全体でしたから上に参照してるからですかね？？
違います。
手作業で試してみれば解ると思います。
Sub 実験用シート生成()
With Worksheets.Add(after:=Worksheets(Worksheets.Count))
.Name = "実験用"
.Range("A15:A19").Merge
.Range("B15:B19").Merge
Intersect(.Rows("15:19"), .Range("D:G")).Merge True
Intersect(.Rows("15:19"), .Range("H:AA")).Merge True
Intersect(.Rows("15:19"), .Range("AB:AG")).Merge True
.Range("A:AG").ColumnWidth = 2
With .Range("C15")
.Value = 1
.AutoFill Destination:=.Resize(5), Type:=xlFillSeries
.Offset(, -2).Value = "A"
.Offset(, -1).Value = "B"
End With
.Range("A15:AG19").Borders.LineStyle = xlContinuous
End With
End Sub
↑を実行して、実験用シートを作った後、
(1)19行目をコピーして19行目に挿入した場合
(2)20行目をコピーして21行目に挿入した場合
それぞれ、A,B列がどうなっているか確認してみてください。
■10
＞二つに分けてるものはちょっと勝手にいじるわけにもいかないので提案してみます。
＞先ほどの2個に分かれてしまっている部分のものはこれで提案してみようと思います。
いや、問題はそこじゃないです。↓が書式じゃないですよと言ってます。
Paste:=xlPasteAllUsingSourceTheme
ちなみに、「セットの追加」のほうはSelectする必要はないです。
"書式"を貼り付けたいならこんな感じだとおもいますよ。
Sub 書式貼付()
Worksheets("フォーマット").Range("A12:AG32").Copy
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2).PasteSpecial Paste:=xlPasteFormats
End Sub
■11
＞これで使いたいセットのD列の一番下のセルを選択することはできたのですが
一旦落ち着きましょう。
'=======================================
Sub 位置()
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(-1, 3).Select
End Sub
'=======================================
Sub 位置2()
ActiveCell.Offset(1, 0).Offset(-1, 3).Select
End Sub
'=======================================
Sub 位置3()
ActiveCell.Offset(0, 3).Select
End Sub
'=======================================
↑全部おなじことになりませんか？
■12
「■６」でも書きましたが、ただあげてるわけじゃないので、ちゃんとステップ実行して研究してみてください。
「実験用シート生成」で作られたシートを想定。
Sub 実験02()
Dim 最終行tmp As Long
Dim MyRNG As Range
With Worksheets("実験用")
Stop '←ブレークポイントのかわり
'▼ユーザーに"セル"を選択させてから、A列をチェックして結合範囲を取得
Set MyRNG = Application.InputBox("コピーしたい行のセルを選んでね", Type:=8)
Set MyRNG = Cells(MyRNG.Row, "A").MergeArea
'▼最終的な最終列を計算して求める
最終行tmp = .Cells(.Rows.Count, "D").End(xlUp).Row + MyRNG.Rows.Count
'▼結合セルを含む行範囲のうち最後の行を行数分挿入する
MyRNG.Cells(MyRNG.Rows.Count, 1).EntireRow.Copy
MyRNG.Cells(MyRNG.Rows.Count, 1).EntireRow.Resize(MyRNG.Rows.Count).Insert Shift:=xlDown
'▼挿入して出来たセル部分を特定してクリアする
Intersect(MyRNG.EntireRow, .Range("E:AG")).Offset(MyRNG.Rows.Count).ClearContents
'▼オートフィルを使って連番を振り直す
.Range("D15").AutoFill Destination:=.Range("D15:D" & 最終行tmp), Type:=xlFillSeries
If MyRNG.Rows.Count = 1 Then
'▼A列が縦に結合されていなかった場合は、例外的に結合処理を実行
MyRNG.Offset(-1, 0).MergeArea.Resize(2).Merge
MyRNG.Offset(-1, 1).MergeArea.Resize(2).Merge
End If
End With
End Sub
（もこな２ ） 2020/03/12(木) 16:45
Sub 実験用シート生成()
With Worksheets.Add(after:=Worksheets(Worksheets.Count))
.Name = "実験用"
.Range("A15:A19").Merge
.Range("B15:C19").Merge
Intersect(.Rows("15:19"), .Range("E:G")).Merge True
Intersect(.Rows("15:19"), .Range("H:AA")).Merge True
Intersect(.Rows("15:19"), .Range("AB:AG")).Merge True
.Range("A:AG").ColumnWidth = 2
With .Range("D15")
.Value = 1
.AutoFill Destination:=.Resize(5), Type:=xlFillSeries
.Offset(, -3).Value = "A"
.Offset(, -2).Value = "B"
End With
.Range("A15:AG19").Borders.LineStyle = xlContinuous
End With
End Sub
（もこな２ ） 2020/03/12(木) 16:54
すみません。
会議前でゆっくり見ていられないので気になったところだけ先に
ActiveCell.Offset(0, 3).Select
だとできなかったのですが…
指定している部分にあるA列のセルが結合されているものなので
いったん下のセルを指定してからその場所から
Dまで移動させて一つ上に戻す形をとったのですが
セルの結合をしている状態でも指定できるのでしょうか？
（はなはな） 2020/03/12(木) 17:22
あの一行を消せばどっちも対応できるかなと思ったのですが…
多分、書式ってむこうの人との理解の違いなのですが
選択範囲の中身一式まるまる全部
そのまま張り付けしたいんだと思います。
入力フォームの入れ物を項目とかひっくるめて貼りたいはずなので
Paste:=xlPasteFormatsではなくPaste:=xlPasteAllで大丈夫なのだと思います。
（はなはな） 2020/03/12(木) 17:42
すみません。
質問の理解が出来ていませんでした。
セルの結合内に挿入をして、結合が解除されないか
セルの結合外に挿入をして、結合できていないか
上記の違いがあるということでよろしかったでしょうか？
（はなはな） 2020/03/12(木) 17:45
それだけの情報じゃわかりません。
同じセルを選択してから、↓を実行してイミディエイトになんと出ているか教えて下さい。
Sub 実験03()
On Error Resume Next
Debug.Print "アクティブセル：" & ActiveCell.Address(0, 0)
Debug.Print "選択中のセル：" & Selection.Address(0, 0)
Debug.Print "想定アドレス１：" & ActiveCell.Offset(0, 3).Address(0, 0)
Debug.Print "想定アドレス２：" & ActiveCell.Offset(0, 3).MergeArea.Address(0, 0)
ActiveCell.Offset(0, 3).Select
Debug.Print "実際に選択されたセル：" & Selection.Address(0, 0)
End Sub
（もこな２ ） 2020/03/12(木) 18:12
です
（はなはな） 2020/03/12(木) 20:59
ActiveCell.Offset(0, 3).Select
↑出来てると思いますが、本当はどうなればよかったんですか？
Range("A13").Offset(1, 0).Select
↑でA14がアクティブになる
Range("A14").Offset(-1, 3).Select
↑でD13を含む結合範囲が選択される
↑と↓は同じですよって言ってるだけですが・・・
Range("A13").Offset(0, 3).Select
■９の返信の返信、
＞上記の違いがあるということでよろしかったでしょうか？
そうです。
今回は、
＞A、B部分に項目的な縦との結合セルがある場合それを延長することは可能なのでしょうか？
とのことなので、前者じゃないと後から結合しなくちゃいけなくなるので、あいだに挿入するようにしています。
■15
＞Paste:=xlPasteFormatsではなくPaste:=xlPasteAllで大丈夫なのだと思います。
そちらはご自身で対応してください。（私の提案の方法はそもそも、コピー＆【インサート】なので【ペースト】は関係ないです。）
言いたかったのは、Selectが要りませんよってことです。
あと、「xlPasteAll」と「xlPasteAllUsingSourceTheme」は別物ですよ。（結果がたまたま一緒になることはあるかもですが）
さらに、「xlPasteAll」でいいなら、PasteSpecialメソッドじゃなくてもよいかもです。
（もこな２） 2020/03/12(木) 21:26
■13
D13を含む結合範囲が選択される
ではなく
D28を含む結合範囲が選択される
にしたいです。
結合部分のイメージですが教えていただいたものでちょっとだけ変えてみたので伝わりますでしょうか
Sub 実験用シート生成()
With Worksheets.Add(after:=Worksheets(Worksheets.Count))
.Name = "実験用"
.Range("A4:A19").Merge
.Range("B15:C19").Merge
Intersect(.Rows("15:19"), .Range("E:G")).Merge True
Intersect(.Rows("15:19"), .Range("H:AA")).Merge True
Intersect(.Rows("15:19"), .Range("AB:AG")).Merge True
.Range("A:AG").ColumnWidth = 2
With .Range("D15")
.Value = 1
.AutoFill Destination:=.Resize(5), Type:=xlFillSeries
.Offset(, -3).Value = "A"
.Offset(, -2).Value = "B"
End With
.Range("A15:AG19").Borders.LineStyle = xlContinuous
End With
End Sub
この場合であれば
Aの結合セルを指定するのではなく
BCの結合セルを指定して作業すれば
ActiveCell.Offset(0, 2).Select
でも大丈夫ということでしょうか？
（はなはな） 2020/03/12(木) 21:49
と書きましたが
教えていただいた実験用シート生成の1が入力されている行に
?ａA日付、内容、備考といった項目の記載がされていました。
塗りつぶしもしてあるので一つ下を参照しなければいけないかもしれません。
（はなはな） 2020/03/12(木) 22:00
（もこな２） 2020/03/12(木) 22:06
アクティブセル：A13 選択中のセル：A13:A28
このときに、D28を含む結合範囲を選択したいのだったら、ちょっと【ActiveCell】から離れて考えないとダメです。
そもそも、ActiveCellは"１つ"しかありません。
今回、選択した「A13:A28」は結合されていますが、"複数"のセルが集まったセル範囲です。
セルが結合されていない状態であれば、「A13:A28」という範囲を選択しつつ、アクティブセルを"A14"にしたり、"A21"にしたりすることは可能です。
しかし、今回は結合されているので、選択された時点で【左上】のセルを選択（Activeに）したことになっちゃいます。
しかし、今回やりたいことは。A28から3つ右のセルを含む結合範囲を取得したいということになりますから、【ActiveCell】だけでは無理です。
ではどうするかというと、「A13:A28」というセル範囲の中でA28セルはどこにあるか考えてみましょう。
まず、A13はどこにあるかというと1行目、１列目のセルですよね。
回りくどい書き方をするとこうです。
Range("A13:A28").Cells(1,1)
A14は、2行目、1列目のセルですから
Range("A13:A28").Cells(2,1)
となります。ここまでは分かりますか？
(----分かった場合のみ読み進めてください----)
この考え方をしていくと「A28」は、最後の行、１列目のセルとなります。
さて、最後の行って何番目の行でしょうか？わからなければ数えちゃえばいいんです。
Range("A13:A28").Rows.Count
↑
「A13:A28というセルの集まり」にある「行の集まり」を「数えなさい」
こんな感じで数えると【16行目】だということがわかります。
ということは。A28セルは
Range("A13:A28").Cells(16,1)
ということになりますよね。
↓のコードを実行して、イミディエイトにどのように出力されるか確認してみてください。
Sub 実験04()
With Range("A13:A28")
Debug.Print "1行目:" & .Cells(1.1).Address(0, 0)
Debug.Print "2行目:" & .Cells(2.1).Address(0, 0)
Debug.Print ""
Debug.Print "行数は"; .Rows.Count & "行です"
Debug.Print "16行目:" & .Cells(16.1).Address(0, 0)
Debug.Print ""
Debug.Print "最後の行、１列目は" & .Cells(.Rows.Count, 1).Address(0, 0)
End With
End Sub
つぎに、「D28を含む結合範囲」のほうです。
これは、あれこれ説明するより↓を読んでもらったほうが早いとおもいます。
http://officetanaka.net/excel/vba/tips/tips50.htm
読んでわかると思いますが、MergeAreaプロパティを使うのが楽です。
ここまでくると、
【アクティブセル】を【含む（結合）セル範囲】のうち【最後の行のセル】から【右に３つずれたセル】が【含まれる（結合）セル範囲】を取得すればよいことに気づきませんか？
これをコードにするとこんな感じです。
Sub 実験05()
Range("A13").Activate
With ActiveCell.MergeArea
Debug.Print .Cells(.Rows.Count, 1).Offset(, 3).MergeArea.Address(0, 0)
End With
End Sub
とりえあず、こういうことですよね。
そのうえで、「実験02」をご覧ください。
何か似ている部分ありませんか？
↓このへん Set MyRNG = Cells(MyRNG.Row, "A").MergeArea MyRNG.Cells(MyRNG.Rows.Count, 1).EntireRow
（もこな２） 2020/03/12(木) 23:40
遅くなってしまい申し訳ありません。
ちょっと別件の仕事も立て込んで煮詰まっているのでまともな返答出なかったらすみません。
そして、次の案件が入ってきてしまったので、あまり時間がかけられなくなってしまいそうなので
この後もなかなか見れないかもしれません…。
実験5の方
2セット上下に作って上下のセットで試してみました。
結合セルの範囲のうち、最後の行のセルからみぎに３つずれたセルでやりたいことが
行えるのはわかりました。
A列をチェックして結合範囲を取得
Set MyRNG = Cells(MyRNG.Row, "A").MergeArea
結合セルを含む行範囲のうち最後の行を
MyRNG.Cells(MyRNG.Rows.Count, 1).EntireRow
さっきのを組み込めば場所の指示ができる…？
（はなはな） 2020/03/13(金) 16:21
https://www.moug.net/faq/viewtopic.php?t=79224
こちらで同様にご質問させていただき、
回答をいただいたことで現状では解決いたしましたのでご報告させていただきます。
繁忙期が過ぎましたら、再度教えていただいた内容を確認していきたいと思います。
ありがとうございました。
（はなはな） 2020/03/16(月) 10:06
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.