[[20220504065443]]　『一週間分のデータをコピーするマクロについて』（素人）　ページの最後に飛ぶ

『一週間分のデータをコピーするマクロについて』（素人）

朝からすみません。ご質問させていただきます。
B5:G29を一組(25行)として、以下31組あります。31組というのは一か月の日付分です。
勿論、月によって日付は変動するので、B列は空欄になる場合があります。
B列は25行ごとにセルを結合させています。
1日～7日分のデータ入力して、それ以下(同じ曜日)にその7日分のデータをコピー(値のみ貼り付け)するマクロを組めたらと思っています。
B列の日付はあらかじめ入ってるものとして、C:Gをコピーしたいというもので。
その際、日付が空欄のところにはコピーしません。あくまで、日付があるところにコピーします。
例えば、4月ですと30日までなので、最後の31組目は日付は空欄なので、コピーしないということになります。
よろしくお願いします。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

ご質問は何でしょうか？

（わからん） 2022/05/04(水) 07:18

ずぶの素人のため、全体的な湿度でした。
（素人） 2022/05/04(水) 08:12

＞全体的な

全体的には、簡単なことと思います。

（わからん） 2022/05/04(水) 08:22

 空白がどうか判断するまでもなく、月の日数は決まっているので・・

 Sub Macro1()
     Dim dys As Long

     dys = Day(Application.EoMonth(Range("B5"), 0))
     Range("C5:G29").Copy
     Range("C30:G30").Resize(25 * (dys - 1)).PasteSpecial Paste:=xlPasteValues
 End Sub

（半平太） 2022/05/04(水) 08:35

 曜日ごとに内容が違うものとして、こんなことですか？

 Sub test()
     Dim lastRow As Long, m As Long, n As Long

     '28日までのコピー
     Cells(5, "C").Resize(7 * 25, 5).Copy
     Cells(5 + 7 * 25, "C").Resize(3 * 7 * 25, 5).PasteSpecial Paste:=xlPasteValues

     '29日から月末までのコピー
     lastRow = Cells(Rows.Count, "B").End(xlUp).Row
     m = (lastRow - 5) / 25 + 1  '月の最終日
     n = m - 28                  '29からの日数
     Cells(5, "C").Resize(n * 25, 5).Copy
     Cells(5 + 28 * 25, "C").Resize(n * 25, 5).PasteSpecial Paste:=xlPasteValues
 End Sub
（γ） 2022/05/04(水) 08:40

半平太様、有難うございます。
ご返事が今になってしまい、すみません。
早速、半平太様のマクロを設定してみましたところ、きちんと貼り付けできました。ただ、1組目(1日)が範囲指定された状態(範囲が点線)になっています。実行の際に、この範囲指定された状態にならないようにすることはできるでしょうか？

γ様、有難うございます。
ご返事が今になってしまい、すみません。
早速、γ様のマクロを設定してみましたところ、日付を4月にして実行しましたところ、日付が空白である31組目の枠にも貼り付けされてしまいました。日付が空白の箇所には貼り付けしないようにできるでしょうか？

どうぞよろしくお願いします。
（素人） 2022/05/04(水) 16:46

追伸
γ様の方も実行後、範囲指定された状態(範囲が点線)になっています。
（素人） 2022/05/04(水) 16:50

31日のところにも計算式が入っているのでは？
それだとどの月も31日までコピーしますよ？
半平太さんのコードを参考にして最終日を求めたらどうですか？

点線の解除は、
Application.CutCopyMode = False
とすればよいでしょう。

ところで、1日から7日の既に入っているデータは、曜日にかかわらず同じ内容なんですか？

（γ） 2022/05/04(水) 17:05

γ様、有難うございます。

31日のところにも計算式が入っているのでは？
→はい、日数を計算する関数を入れています。以下の通りです。
→B755=IF(MONTH($B$5)=MONTH($B$680+3), $B$680+3, "")

半平太さんのコードを参考にして最終日を求めたらどうですか？
→はい、やってみます。

点線の解除は、Application.CutCopyMode = Falseとすればよいでしょう。
→γ様、半平太様のマクロに追加したところ、点線解除できました！

ところで、1日から7日の既に入っているデータは、曜日にかかわらず同じ内容なんですか？
→いいえ、曜日によって異なりますし、25行すべてにデータが入るとは限りません。空き行はかなりあります。

γ様、もう一つ教えてください。
実行後、29日～空白(31日)までが範囲選択された状態で終了するのですが、これを範囲選択されずに、先頭行のままで終了させたいのです。

（素人） 2022/05/04(水) 17:21

先頭行を選択し直すことは、あなたの自由です。
（γ） 2022/05/04(水) 17:28

先頭行を選択し直すことは、あなたの自由です。
→これはどういう意味合いでしょうか？理解できず、ごめんなさい。
→29日～空白(31日)の範囲選択を解除する方法はあるでしょうか？
→先頭行というより、実行ボタんを押した時点の画面(1日であろうと7日であろうとその時点の画面)から移動しないようにしたいです。
（素人） 2022/05/04(水) 17:36

最終時点での選択状態があなたの希望と異なるなら、
あなたの希望する選択にしてください。
私が提示したコードはあくまで参考です。
あなたが自由に変更していいですよ、という意味ですが、
おかしなこと言いましたか？

コードを提示しないといけない義務は当方にはありません。
（γ） 2022/05/04(水) 17:49

そういう意味ではありませんでした。お気を悪くさせてしまい、ごめんなさい。ありがとうございました。
（素人） 2022/05/04(水) 17:51

＞ずぶの素人のため、全体的な湿度でした。

ずぶの素人は、マクロの事など知らん。
（嘘八百） 2022/05/04(水) 17:52

新しいところ選択すれば、今残っている選択範囲は残りません。
好きなところを選択し直してください。
ちなみに、半平太さんの提示されているコードは、
1日のデータを月内の日にコピーするものですから、
よく理解してください。
# 外出中でスマフォで打っています。取り敢えずここまでとします。
（γ） 2022/05/04(水) 18:26

1日のデータを月内の日にコピーするものですから、よく理解してください。
→なるほど、そうでした。これでは、困ります。1日～7日のデータはそれぞれ異なります。

29日～空白(31日)の範囲選択は、以下の追加で解除できました。いかがでしょうか？
ただ、理想としては、実行直前の位置に戻したいのがあります。これだと、決まった場所に必ず戻るということですよね。
あとは、空白部分にコピーしないようにするだけです。

Sub test()

     Dim lastRow As Long, m As Long, n As Long
     '28日までのコピー
     Cells(5, "C").Resize(7 * 25, 5).Copy
     Cells(5 + 7 * 25, "C").Resize(3 * 7 * 25, 5).PasteSpecial Paste:=xlPasteValues
     '29日から月末までのコピー
     lastRow = Cells(Rows.Count, "B").End(xlUp).Row
     m = (lastRow - 5) / 25 + 1  '月の最終日
     n = m - 28                  '29からの日数
     Cells(5, "C").Resize(n * 25, 5).Copy
     Cells(5 + 28 * 25, "C").Resize(n * 25, 5).PasteSpecial Paste:=xlPasteValues
     Application.CutCopyMode = False
     Range("C5").Select
End Sub

γさん、外出先からありがとうございます。そして、ごめんなさい。
（素人） 2022/05/04(水) 18:58

半平太様とγ様のコード部分で、
４月は30日までなので、最終箇所は日付が空欄(式は入っている)となるため、コピーもしないという形にするため、γ様から、「半平太さんのコードを参考にして最終日を求めたらどうですか？」のアドバイスをいただき、自分なりに以下のようにコードを修正してみましたが、エラーがかえってきてしまいます。
どのような修正が必要でしょうか？

Sub test()

     Dim lastRow As Long, m As Long, n As Long
     '28日までのコピー
     Cells(5, "C").Resize(7 * 25, 5).Copy
     Cells(5 + 7 * 25, "C").Resize(3 * 7 * 25, 5).PasteSpecial Paste:=xlPasteValues
     '29日から月末までのコピー
     lastRow = Cells(Rows.Count, "B").End(xlUp).Row
     m = (lastRow - 5) / 25 + 1  '月の最終日
     n = m - 28                  '29からの日数
     Cells(5, "C").Resize(n * 25, 5).Copy
     Cells(5 + 28 * 25, "C").Resize(25 * (dys - 1)).PasteSpecial Paste:=xlPasteValues
     Application.CutCopyMode = False
     Range("C5").Select
End Sub
（素人） 2022/05/05(木) 20:19

      lastRow = Cells(Rows.Count, "B").End(xlUp).Row
      m = (lastRow - 5) / 25 + 1  '月の最終日
 で変数mにその月の最終日を求めたのですが、
 それを消して、半平太さんの
      dys = Day(Application.EoMonth(Range("B5"), 0))
 の式をそのままmを計算するのに使えばいいんじゃないですか？

 半平太さんのコードを意味を理解していますか？
 ワークシート関数EOMONTHを使っているのですから、
 それを調べたらどうですか？
（γ） 2022/05/05(木) 20:38

γ様がおっしゃるように、半平太様のコードでmを計算するようにしたところ、日付が空白部分にはコピーしないようになりました。
Range("C5").Select←この部分を実行直前の画面から移動させないように出来たらと思ってますので、自分なりに調べてみたいと思っています。
ありがとうございます。

Sub test()

     Dim lastRow As Long, m As Long, n As Long
     '28日までのコピー
     Cells(5, "C").Resize(7 * 25, 5).Copy
     Cells(5 + 7 * 25, "C").Resize(3 * 7 * 25, 5).PasteSpecial Paste:=xlPasteValues
     '29日から月末までのコピー
     lastRow = Cells(Rows.Count, "B").End(xlUp).Row
     m = Day(Application.EoMonth(Range("B5"), 0))  '月の最終日
     n = m - 28                  '29からの日数
     Cells(5, "C").Resize(n * 25, 5).Copy
     Cells(5 + 28 * 25, "C").Resize(n * 25, 5).PasteSpecial Paste:=xlPasteValues
     Application.CutCopyMode = False
     Range("C5").Select
End Sub
（素人） 2022/05/06(金) 07:24

 Sub test()
     Dim m As Long, n As Long
     Dim r As Range

     Application.ScreenUpdating = False
     Set r = ActiveCell      'セルの位置を記憶

     '(今の処理をここに書く）

     Application.CutCopyMode = False
     r.Select                'セルの位置を復旧
     Application.ScreenUpdating = True
 End Sub
 とすればいいですよ。

 Application.ScreenUpdating = False
 としておけば、画面更新は抑止されます。
 そのうえで、処理スタート時点の現在位置を記憶し、
 処理後にそれを戻せばいいでしょう。

 ちなみに、lastRowはお蔵入りですから消したほうがいいでしょう。
（γ） 2022/05/06(金) 07:57

いまさらですが、「全体的には、簡単」とかいっておいて何もしないのも申し訳ないので、
コードを提示しておきます（スルーして構いません）。

 Sub Test()
    r = 5
    Do While Cells(r + 25 * 7, "B") <> ""
        Range(Cells(r + 25 * 7, "C"), Cells(r + 25 * 8 - 1, "G")).Value = Range(Cells(r, "C"), Cells(r + 25 - 1, "G")).Value
        r = r + 25
    Loop
 End Sub

（わからん） 2022/05/06(金) 08:20

γ様、わからん様、どちらのコードも実行してみました。
まさに、私の希望通りの動き、結果となりました。
この内容に関連して、並べ替えさせるマクロについて、改めて質問させていただこうと思います。
ありがとうございました。
（素人） 2022/05/06(金) 20:04

コメント返信：

[ 一覧(最新更新順) ]

[[20220504065443]] 『一週間分のデータをコピーするマクロについて』（素人） ページの最後に飛ぶ

[[20220504065443]]　『一週間分のデータをコピーするマクロについて』（素人）　ページの最後に飛ぶ