[[20060315120452]]　『削除した行の分だけ挿入「コピー」したい』（アライ）　ページの最後に飛ぶ

『削除した行の分だけ挿入「コピー」したい』（アライ）

 こんにちは
以前この学校でお世話になり改良を重ねこのような素晴らしい物が出来ました。
実際に稼動して行く内に問題が発生し解決策をご教授していただきたくまいりました。
どうぞ宜しくお願いいたします。

 「請求シート」「事務処理終了シート」という２枚のシート構成になっております。
請求シートのＧ列に日付が入力された時、庶務の担当者が確認し以下のモジュールを実施し
事務処理終了シートにコピーし、コピー元（列）を削除しています。

 Sub 納品日削除()

 Sheets("請求シート").Select

 Dim i As Long

    For i = Range("g65536").End(xlUp).Row To 3 Step -1
        If Cells(i, 7).Value <> "" Then
             Rows(i).Copy
                Worksheets("事務処理終了シート").Rows(3).Insert Shift:=xlDown
                    Rows(i).Delete Shift:=xlUp         
        End If
    Next i

    Sheets("事務処理終了シート").Select
         Range("A3").Select
End Sub

 請求シートには、数式が約1000行入っていたんですが、先日確認したところ300行程度に減っていました。
庶務の担当者が事務処理をした結果このような事態が発生いたしました。
削除する行は、1列おきだったり、飛び飛びだったり、まとめて5行だったりします。
ここで教えていただきたいのは、削除した分だけ増やす事ができるのでしょうか？
5行削除された時は、数式の入ってる行が1000-5で995行残っているので
995行目を選び、その下に5行コピーペーストするというような形で
宜しいのでしょうか？どうぞ、宜しくお願いいたします。　(アライ）

 コピーしても使用できる数式で最後の行にデータ入力がなければ
 削除した行数をカウントしておいて、その行数だけ最終行の下に
 いっきにコピペ（挿入）するとできると思います。
 （やっちん）

 >数式が約1000行入っていたんですが、

 行をカットした後フィルしているだけですが どうでしょう^^
予め1000行まで数式をコピーして置いてください
(kohe)

Sub 納品日削除()

 Sheets("請求シート").Select

 Dim i As Long

    For i = Range("g65536").End(xlUp).Row To 3 Step -1
        If Cells(i, 7).Value <> "" Then
             Rows(i).Cut'-----------------------変更
                Worksheets("事務処理終了シート").Rows(3).Insert Shift:=xlDown
                    Rows(i).Delete Shift:=xlUp

                    Rows("999:999").AutoFill Destination:= _   '追加
                    Rows("999:1000"), Type:=xlFillDefault      '追加

        End If
    Next i

    Sheets("事務処理終了シート").Select
         Range("A3").Select
End Sub

やっちん様　kohe様　ありがとうございました。完璧です。

 ＞Rows("999:999").AutoFill Destination:= _   
  Rows("999:1000"), Type:=xlFillDefault      '追加

 たったこれだけの記述で出来てしまうんですね
この式をネットで検索し大まかには理解できました。
本当に有難う御座いました。

重ねてのお願いですいません

 右の作業列にカウントするため
=SUMPRODUCT(($B$3:$B$300=W1)*($F$3:$F$300=$U$2))
このような数式が入っています。
初期設定は
=SUMPRODUCT(($B$3:$B$1000=W1)*($F$3:$F$1000=$U$2))
だったのですが。。。
処理を繰り返してる間に$B$1000がB$300に減少してしまいました。
勿論このような数式でなくてもかまいません
上記処理を実行した時に参照範囲が変わらない設定を
教えていただけますか？
宜しく御願い致します。  (アライ)

 式を初期設定に戻すのは、最終行の前に必要な行数だけコピーで挿入すれば簡単ですね。
 同じ理由でフィルではなくて挿入だったら気にする必要もなかったんですが。
 （やっちん）

やっちん様　早急に有難う御座いました

 ちょっと自分には手が出ない領域なのですが
でも、チャレンジしてみます。
＞最終行の前に必要な行数だけコピー
これがポイントですよね、多分
数時間、時間をください宜しく御願い致します　（アライ）

 オペレーションとしては、
 最後の行をコピーして
 必要な行数分を最後の行から下方向に行を選択して
 「コピーしたセルの挿入」。
 これをVBAにさせるということです。
 （やっちん）

 >=SUMPRODUCT(($B$3:$B$1000=W1)*($F$3:$F$1000=$U$2))
 >だったのですが｡｡｡

 改良版です

 Sub 納品日削除()

 Sheets("請求シート").Select

 Dim i As Long

    For i = Range("g65536").End(xlUp).Row To 3 Step -1
        If Cells(i, 7).Value <> "" Then
             Rows(i).Cut '-----------------------変更
                Worksheets("事務処理終了シート").Rows(3).Insert Shift:=xlDown
                    Rows(i).Delete Shift:=xlUp

                         '↓数式がH列の場合
                    Range("H3") = "=SUMPRODUCT(($B$3:$B$1000=W3)*($F$3:$F$1000=$U$2))"
                    Range("H3").AutoFill Destination:=Range("H3:H1000")
                                                              '↑数式がH列の場合
         End If
    Next i

    Sheets("事務処理終了シート").Select
         Range("A3").Select
 End Sub

 行を増やす部分はいらなくなったのでしょうか？何かしら書式があったりするのかなあと思うのですが。
 それと、式を入れる場合はループの外で１回で済ませた方がいいかなと。
 ついでにプロパティも省略せずにFormula付けた方がいいですよ。
 すいません、ちょっと気になったもので。
 （やっちん）

やっちん様気にかけていただき有難う御座いました

 増やす部分は相変わらず必要なんですが、、、

 ＞Range("H3") = "=SUMPRODUCT(($B$3:$B$1000=W3)*($F$3:$F$1000=$U$2))"
この数式の部分でIF処理が実際は施してある関係で上手く働きませんでしたので
やっちん様の方法で頑張っていますが、いかんせん、、、

あれから今までＰＣにかぶりつき

 Sub 納品日削除()

 Sheets("請求シート").Select

 Dim i As Long

    For i = Range("g65536").End(xlUp).Row To 3 Step -1
        If Cells(i, 7).Value <> "" Then
             Rows(i).Copy
                Worksheets("事務処理終了シート").Rows(3).Insert Shift:=xlDown
                    Rows(i).Delete Shift:=xlUp
                        Sheets("請求シート").Select
                            Range("D65536").End(xlUp).Rows.Select

        End If
    Next i

    Sheets("事務処理終了シート").Select
    Range("A3").Select
End Sub

ここまでです

 最終行を取得（セル）
ここに削除した分だけ挿入といけば良いのですが、、、　
どうぞ宜しく御願い致します　　　（アライ）

 今まで行を削除して式の結果がおかしくなっていないのであれば
 これでいいのかなあ。
 必ず行を削除しても2行以上残ることが前提です。
 Sub 納品日削除()
    Dim i As Long
    Dim Cnt As Long
    Const LastRow = 1000  '<-最終行

    Sheets("請求シート").Select

    Cnt = 0
    For i = Range("g65536").End(xlUp).Row To 3 Step -1
        If Cells(i, 7).Value <> "" Then
             Rows(i).Copy
             Worksheets("事務処理終了シート").Rows(3).Insert Shift:=xlDown
             Rows(i).Delete Shift:=xlUp
             Cnt = Cnt + 1
        End If
    Next i
    If Cnt > 0 Then
        Rows(LastRow - Cnt).Copy
        Rows((LastRow - Cnt) & ":" & (LastRow - 1)).Insert Shift:=xlDown
        Application.CutCopyMode = False
    End If
    Sheets("事務処理終了シート").Select
    Range("A3").Select
 End Sub

どなたか存じませんが有難う御座いました

 完璧に思い通りの結果になりました。
＞必ず行を削除しても2行以上残ることが前提です。
この部分に関しては、問題なくクリアできます
行を多めに設定し
この行には入力しないでください
次回請求までお待ちください等の記載で済む事ですので
早朝の時間にご教授していただき有難う御座いました
このサイトの運営に携わる皆様
また回答をしてくださる諸先生方
本当に有難う御座いました
今後とも宜しく御願い致します。
失礼させて頂きます　　　（アライ）

 すいません、名前書くの忘れてました(^^;
 2行以上と書きましたが、式で指定している先頭行または最終行を削除すると式がおかしくなります。
 今まで行を削除して大丈夫だったところから、この2行は削除していないのでしょうね。
 （やっちん）

 to やっちん さん
 >すいません、ちょっと気になったもので。
 とんでもありません ご忠告ありがたく思います
 >完璧です。
 で舞い上がってしまいました
 これからも稚拙コードですが ご指導添削お願いいたします
 (kohe)

すいません

 申し訳ありませんが、説明していただけると嬉しいのですが
どうぞ宜しく御願い致します。

 >Cnt = Cnt + 1

 >If Cnt > 0 Then
    Rows(LastRow - Cnt).Copy
    Rows((LastRow - Cnt) & ":" & (LastRow - 1)).Insert Shift:=xlDown

                                                      (アライ)

 >Cnt = Cnt + 1
 は削除された行を数えています。

 >If Cnt > 0 Then
    Rows(LastRow - Cnt).Copy
    Rows((LastRow - Cnt) & ":" & (LastRow - 1)).Insert Shift:=xlDown
 は1行以上削除された場合に最終行をコピーし
 削除された行数分、最終行の前に挿入しています。
 Rows()の中の値がどうなっているのかは御自分でシミュレーションしてみてください。

 前にも書きましたが
 >オペレーションとしては、
 >最後の行をコピーして
 >必要な行数分を最後の行から下方向に行を選択して
 >「コピーしたセルの挿入」。
 >これをVBAにさせるということです。
 まさにこれです。
 同じことをマクロの記録で行うと似たようなコードができます。
 私はそれにちょっと手を加えただけです。

 koheさんへ。
 お互いステップアップしていきましょう(^^
 （やっちん）

有難う御座いました

 自動記録に手を加えただけですか
ゆっくり解読したいと思います
感謝いたします　　（アライ）

コメント返信：

[ 一覧(最新更新順) ]

[[20060315120452]] 『削除した行の分だけ挿入「コピー」したい』（アライ） ページの最後に飛ぶ

[[20060315120452]]　『削除した行の分だけ挿入「コピー」したい』（アライ）　ページの最後に飛ぶ