[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『最終行の行数がシート間で一致するまで行を挿入したい』（満月）
初めまして。
ネットで同じようなものを見つけて参考にしながら作り変えてみたのですが、うまくいきません。教えて下さい。
シートは、"まとめ"、"1"、"2" の3シートあります。
まとめシートと1, 2のシートの行数が違う場合は、1, 2のシートの行数をまとめシートと同じ行数まで「行挿入」して合せたいです。
（1, 2のシートの行数は同じで、まとめシートだけ行数が多い状態からスタートとする）
Ａ列については、全てのシート同一としたいので、1, 2のシートのA列は 「=まとめ!A〇」としています。
また、1, 2のシートは、合計行のB列に例えばB2セルには「=SUM(B3:B5)」と数式が入っているので、行を挿入した際もこの合計の式は数式コピーさせたいです。（4行が1セットとしてコピーさせたいです）
＜まとめシート＞
A B
1 商品 個数
2 合計 6
3 A 1
4 B 2
5 C 3
6 合計 8
7 A 2
8 B 3
9 C 3
10 合計 6
11 A 2
12 B 2
13 C 2
＜1 及び 2のシート＞
A B
1 商品 個数
2 合計 0 ←=SUM(B3:B5)
3 A
4 B
5 C
Sub 行挿入()
Dim LastRow1 As Long
Dim LastRow2 As Long
LastRow1 = Worksheets("まとめ").Range("A1").End(xlDown).Row
LastRow2 = Worksheets("1").Range("A1").End(xlDown).Row
Do
If Worksheets("まとめ").Cells(LastRow1, 1).Row <> Worksheets("1").Cells(LastRow2, 1).Row Then
Worksheets(Array("1", "2")).Select
Rows(LastRow2).Select
Selection.Offset(-3, 0).Range("A1:B4").Copy
Cells(LastRow2, 1).Offset(1, 0).Insert
End If
Loop Until Workbooks("1").Cells(LastRow2, 1).Row = Workbooks("まとめ").Cells(LastRow1, 1).Row
Worksheets("まとめ").Select
Application.CutCopyMode = False
End Sub
下記でエラーになります。
Loop Until Workbooks("1").Cells(LastRow2, 1).Row = Workbooks("まとめ").Cells(LastRow1, 1).Row
やりたいのは、「シート1, 2の挿入した後の最終行がまとめシートの最終行と一致するまで」と書いたつもりなのですが…。
ステップインで順番にやっていくと、１のシートには6〜9行目には意図通り挿入されるが、10行目以降には挿入されず。
また、２のシートは挿入もされず変化なし。（LastRows2の指定時にWorksheets("1")の行を取得しているから"2"のシートには反応しないのか？？）
LastRow2の変数は挿入後も、挿入前の”５”行目を表したまま。
この辺りがうまくいかない理由なのかな…と思いますが、ご教授頂けますでしょうか。
宜しくお願いいたします。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
個数のところを無視するならば、行挿入は関係なくて
(1)まとめシートのA列をコピーする (2)1 及び 2のシートのA列に貼付する (3)↑のシートそれぞれに（3行おきに？）SUM関数を設定する。
という処理をすればよいようにも読めますので・・・
（もこな２ ） 2021/09/23(木) 11:27
どうなればいいか↓↓
A B
1 商品 個数
2 合計 0
3 A
4 B
5 C
6 合計 0
7 A
8 B
9 C
10 合計 0
11 A
12 B
13 C
（満月） 2021/09/23(木) 11:46
Sub 研究用()
Dim SH As Worksheet
Dim i As Long
Dim str As String
For Each SH In Worksheets(Array("1", "2"))
With SH
Worksheets("まとめ").Range("A:A").Copy .Range("A1")
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row - 2 Step 4
.Cells(i + 2, "B").Formula = "=SUM(" & Range("B3:B5").Offset(i - 2).Address(False, False) & ")"
Next i
End With
Next SH
End Sub
ちなみに普通は「まとめ」シートというのであれば
【1シート】
__A__ __B__ __C__
1 月 商品 個数
2 １月 A 1
3 １月 B 1
4 ２月 C 3
5 ３月 A 2
6 ３月 C 2
【2シート】
__A__ __B__ __C__
1 月 商品 個数
2 １月 B 1
3 １月 C 3
4 ２月 A 2
5 ２月 B 3
6 ３月 B 2
↓ 対象シートの結果を"まとめ"シートに合算して表示したい
【まとめシート】 __A__ __B__ 1 商品 個数 2 1月計 6 3 A 1 4 B 2 5 C 3 6 2月計 8 7 A 2 8 B 3 9 C 3 10 3月計 6 11 A 2 12 B 2 13 C 2
みたいなことになりそうなんですが、そうではないのですよね？
（念のための確認です。）
（もこな２ ） 2021/09/23(木) 12:17
If Worksheets("まとめ").Cells(LastRow1, 1).Row <> Worksheets("1").Cells(LastRow2, 1).Row Then
Worksheets(Array("1", "2")).Select
Rows(LastRow2).Select
Selection.Offset(-3, 0).Range("A1:B4").Copy
Cells(LastRow2, 1).Offset(1, 0).Insert
ですが、私の考えたコードでは、まとめシートの最終行（13行目)までシート1, 2も行数を挿入したいのですが、9行目までしか挿入できない（下記コードの使い方が恐らく間違えているので…）、今回ご教授頂ければと思い、投稿させていただきました。
Loop Until Workbooks("1").Cells(LastRow2, 1).Row = Workbooks("まとめ").Cells(LastRow1, 1).Row
（満月） 2021/09/23(木) 15:51
かつ、あの後色々考えて、行を4行セットで挿入した後に、1のシートの最終行（LastRow2)の値を再度取り直さないと、挿入した分が反映しないので、LastRow3としてもう一度最終行を取り直したら一応動きました。
但し、２のシートの方は別々にやらないとダメみたいで、けっきょく同じことを2回繰り返す（LastRow4, LastRow5もさらに作って…）をやったらアウトプットは意図通りにはいきました。
ですが、コードが長すぎて（実際はもう2シート追加になるので）シンプルではありません。。
今後の勉強の為に、このようなケースで一気に指定するのに良い方法ご存じの方がいらっしゃいましたら、教えて頂けますと幸いです。
Sub 行挿入()
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim LastRow3 As Long
Dim LastRow4 As Long
Dim LastRow5 As Long
LastRow1 = Worksheets("まとめ").Range("A1").End(xlDown).Row
LastRow2 = Worksheets("1").Range("A1").End(xlDown).Row
Do
If Worksheets("まとめ").Cells(LastRow1, 1).Row <> Worksheets("1").Cells(LastRow2, 1).Row Then
Worksheets("1").Select
Rows(LastRow2).Select
Selection.Offset(-3, 0).Range("A1:B4").Copy
Cells(LastRow2, 1).Offset(1, 0).Insert
End If
LastRow3 = Worksheets("1").Range("A1").End(xlDown).Row
Loop Until Worksheets("1").Cells(LastRow3, 1).Row = Worksheets("まとめ").Cells(LastRow1, 1).Row
LastRow4 = Worksheets("2").Range("A1").End(xlDown).Row
Do
If Worksheets("まとめ").Cells(LastRow1, 1).Row <> Worksheets("2").Cells(LastRow4, 1).Row Then
Worksheets("2").Select
Rows(LastRow4).Select
Selection.Offset(-3, 0).Range("A1:B4").Copy
Cells(LastRow4, 1).Offset(1, 0).Insert
End If
LastRow5 = Worksheets("2").Range("A1").End(xlDown).Row
Loop Until Worksheets("2").Cells(LastRow5, 1).Row = Worksheets("まとめ").Cells(LastRow1, 1).Row
Worksheets("まとめ").Select
Application.CutCopyMode = False
End Sub
宜しくお願いいたします。
そして、もこな2様、私の説明不足によりお手数おかけして大変申し訳ありません。教えて頂いたコード、考え方は、非常に勉強になりました。
（満月） 2021/09/23(木) 16:21
横から失礼します。 ブック内の複数シートは複数のセル範囲であるコレクションごとに同じ処理を繰り返す場合は、 For Each...Next ステートメントを使用するのが良いと思います。 その他気になる点は、もこな２さんが回答して下さるかもしれません。
Sub sample()
Dim ws As Worksheet
Dim iRow As Long, buf As Long
iRow = Worksheets("まとめ").Range("A2").End(xlDown).Row
For Each ws In Worksheets
If ws.Name = "まとめ" Then GoTo Continue
With ws.Range("A2").End(xlDown)
buf = iRow - .Row
If Not buf > 0 Then GoTo Continue
.Resize(buf).Offset(1).EntireRow.Insert
.Resize(4).Offset(-3).EntireRow.Copy
With .Resize(buf).Offset(1).EntireRow
.PasteSpecial
On Error Resume Next
.SpecialCells(xlCellTypeConstants).ClearContents
On Error GoTo 0
End With
End With
Continue:
Next ws
End Sub
満月さんの希望に沿いますでしょうか。 （#） 2021/09/23(木) 18:39
追加の質問で恐縮ですが、もし不要シートがいくつかあった場合飛ばしたい場合の指定方法を教えて下さい。
ws.Nameを下記のような書き方ではエラーとなったのですが、まとめシート以外に、Sheet4, Sheet5だった場合も飛ばしたい場合は何か良い方法はありますか？
If ws.Name = "まとめ" Or "Sheet4" Or "Sheet5" Then GoTo Continue
（満月） 2021/09/23(木) 19:09
提示のあったコードを実際に動かしてみて、何となくやりたいことはなんとなく分かりました。
たぶん↓で同じ結果にはなるんじゃないですかね。
Sub 別案1()
Dim 必要行数 As Long
Dim SH As Worksheet
必要行数 = Worksheets("まとめ").Cells(Rows.Count, "A").End(xlUp).Row - 1
For Each SH In worksshets(Array("1", "2"))
SH.Range("A2:B5").AutoFill Destination:=SH.Range("A2:B5").Resize(必要行数)
Next SH
End Sub
おそらく作業グループにして、いっぺんに処理することを考えていらっしゃるとおもうんですが、どうせマクロで実行するため手間にならないのですから、割り切って１シートずつ処理してもいいんじゃないですか？
（マクロで作業グループを取り扱うことはできますが、コードのほうを工夫するほうが手間じゃないのかなと・・・）
また、先にまとめシートから全部コピーして、いらないところだけクリアしていくというアプローチもありますね。
Sub 別案2()
Dim i As Long
Dim SH As Worksheet
For Each SH In Worksheets(Array("1", "2"))
With Worksheets("まとめ")
.Range("A1", .Cells(.Rows.Count, "B").End(xlUp)).Copy SH.Range("A1")
For i = 3 To SH.Cells(Rows.Count, "B").End(xlUp).Row Step 4
SH.Cells(i, "B").Resize(3).Clear
Next i
End With
Next SH
End Sub
（もこな２ ） 2021/09/23(木) 19:09
#様
先ほど、19:09に追加の質問をしました件、IFを除外したいシート分書いてみたら出来ました。
#様がやるとしてもこのようにされますか？
If ws.Name = "まとめ" Then GoTo Continue
If ws.Name = "Sheet4" Then GoTo Continue
If ws.Name = "Sheet5" Then GoTo Continue
（満月） 2021/09/23(木) 19:26
提示されたコードを修正するならこうでしょうか。 If ws.Name = "まとめ" Or ws.Name = "Sheet4" Or ws.Name = "Sheet5" Then GoTo Continue Select Case を使う方法もありだと思います。
Select Case ws.Name
Case "まとめ", "Sheet4", "Sheet5"
GoTo Continue
Case Else
'実行する処理
End Select
＞もこな２さん いつもコードを参考にさせていただいております。 今回も大変勉強になりました。 ありがとうございました。 （#） 2021/09/23(木) 20:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.