[[20250502204747]]　『転記先シートのひな形が崩れてしまう』（ちっち）　ページの最後に飛ぶ

『転記先シートのひな形が崩れてしまう』（ちっち）

教えてください。
収納調書シートから会計1.シートへ転記させたいです。
以下のコードだと転記自体はうまくいくのですが、会計1.シート100行目にあった合計行や、罫線がすべて消えてしまいます。
どのようにコードを変更させればよいのでしょうか？

Sub 学級費_収()

　With Sheets("会計1.").Cells(Rows.Count, "A").End(xlUp)
　　.Offset(1, 0).Resize(3) = Sheets("収納調書").Range("G2").Value '日付
　　.Offset(1, 1).Resize(3) = Sheets("収納調書").Range("I3").Value '整理番号
　　.Offset(1, 3).Resize(3) = Sheets("収納調書").Range("I5").Value '項目
　　.Offset(1, 4).Resize(3) = Sheets("収納調書").Range("C19:C21").Value '内訳
　　.Offset(1, 5).Resize(3) = Sheets("収納調書").Range("G19:G21").Value '単価
　　.Offset(1, 6).Resize(3) = Sheets("収納調書").Range("I19:I21").Value '数量
　　.Offset(1, 7).Resize(3) = Sheets("収納調書").Range("J19:J21").Value '金額
　End With

　'空白がある場合
　If WorksheetFunction.CountBlank(Sheets("会計1.").Range("A1").CurrentRegion.Columns(5)) > 0 Then
　　'空白行を削除
　　Sheets("会計1.").Range("A1").CurrentRegion.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
　End If
　
　MsgBox "処理が完了しました。", 0, "確認"

End Sub

＜使用 Excel：Excel2021、使用 OS：Windows11 ＞

 ＞Sheets("会計1.").Range("A1").CurrentRegion.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 上記の部分で、
 Columns(5)（今回はE列）に空白のセル（xlCellTypeBlanks）がある場合、
 その空白セルを含む行を削除（EntireRow.Delete）するコードになっています。

 消えてほしくない合計行が100行目固定だとして、乱暴に場当たり対応するならば、

    With Sheets("会計1.")
        .Range("E100") = "dummy"
        On Error Resume Next
        .Range("A1").CurrentRegion.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
        .Cells(Rows.Count, "E").End(xlUp).ClearContents
    End With

 とでもしておけば削除されないのでは。
（知らんけど） 2025/05/02(金) 21:48:24

返信ありがとうございます。
（知らんけど）さんのコードで、罫線は維持できるようになりました。
…が、Resize(3)のところは必ず3行埋まるわけではないので、空白行は削除したいです。
掲載したコードも、youtubeで見たものに少し手を加えただけのど素人で…
よろしくお願いします。
（ちっち） 2025/05/03(土) 09:45:45

（知らんけど）さん、大変失礼しました。
シート名の会計1.は〇囲み数字の間違いで、私のコード入力ミスでした。
無事、罫線を維持できて空白行も削除できておりました。
ありがとうございました。
（ちっち） 2025/05/03(土) 09:50:55

たびたび申し訳ありません。
実行したものを見てみると、101行目にある合計欄がE列の空白行分ずつ上にスライドしてしまいます。
同様のコードで支出伺もあるのですが、こちらはResize(15)になっているので、最大14行スライドしてしまうのですが…
何か手立てはありますでしょうか？

（ちっち） 2025/05/03(土) 14:06:14

 「会計1.」シートのE列（内訳）がブランクだったら、その行は空白になればいいという事ですよね。
 元のコードがDeleteだったのでそのまま使いましたが、そういうことならClearContentsで良いのでは。
（知らんけど） 2025/05/03(土) 14:35:17

 そもそも必要な部分だけ転記するコード。
 ・転記の条件
 　内訳列が空白なら、その行は転記しない（質問のコードから推測）
 　「会計1.」シートの体裁は弄らない。
 ※支出伺にも転用しやすいように、できるだけ元のコードを活かしています。

    Sub 学級費_収_1()
        Dim i As Long, n As Long
        With Sheets("会計1.").Cells(Rows.Count, "A").End(xlUp)
            For i = 19 To 21    '内訳の範囲 C19:C21
                If Sheets("収納調書").Cells(i, "C") <> "" Then
                    n = n + 1
                    .Offset(n, 0) = Sheets("収納調書").Range("G2")      '日付
                    .Offset(n, 1) = Sheets("収納調書").Range("I3")      '整理番号
                    .Offset(n, 3) = Sheets("収納調書").Range("I5")      '項目
                    .Offset(n, 4) = Sheets("収納調書").Cells(i, "C")    '内訳
                    .Offset(n, 5) = Sheets("収納調書").Cells(i, "G")    '単価
                    .Offset(n, 6) = Sheets("収納調書").Cells(i, "I")    '数量
                    .Offset(n, 7) = Sheets("収納調書").Cells(i, "J")    '金額
                End If
            Next
        End With
        MsgBox "処理が完了しました。", Title:="確認"
    End Sub

 これで一旦区切りとしますのでご承知を。
（知らんけど） 2025/05/03(土) 15:35:25

期待通りの動きになりました。
（知らんけど）さん、ありがとうございました。
（ちっち） 2025/05/03(土) 16:17:12

コメント返信：

[ 一覧(最新更新順) ]

[[20250502204747]] 『転記先シートのひな形が崩れてしまう』（ちっち） ページの最後に飛ぶ

[[20250502204747]]　『転記先シートのひな形が崩れてしまう』（ちっち）　ページの最後に飛ぶ