複数情報が入っている1行を、複数行に分ける（複製する？？）マクロの組み方について②

知識をお持ちの方がいらっしゃれば、お力添えいただけると嬉しいです。。。

以下のシート（元ｼｰﾄ）を、貼り付け先シートのイメージにマクロで組み替えたいです。
※2sheetは同じファイルです。

＜元ｼｰﾄ＞
・A～U列：品番や担当者名などの情報
・V～Y列：今回は不要なデータです
・Z~CG列：月ごとの数値データが5列ずつ×列で12セット

＜貼り付け先シートで実現したいこと＞→元ｼｰﾄの1行を、月別12行に組み替える
・A～U列：元ｼｰﾄの1行を12行コピペ
・V列：2019/4/1、2019/5/1、、、2020/3/1と月ごとに12行入力
・W～AA列：元データの、月ごとの数値データ5列ずつ×12行

色々知識を貸していただき、下記の記述にたどり着きました。
しかし、下記の問題が生じ、正常に動きません。
・A列～U列が、貼り付け先で13行複製されている（12行が理想）&13行目のW~AA列は空欄
・貼り付け先のV列が全て「1900/1/0」

下記記述の問題点がお分かりの方は、ご指摘&どう直せばよいか助言いただけると幸いです。。

・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・

Sub テスト()

Dim sh1 As Worksheet, sh2 As Worksheet
Dim r1 As Long, r2 As Long
Dim c As Integer, cmax As Integer
Dim sdate As Date
Application.ScreenUpdating = False
Set sh1 = Worksheets("元ｼｰﾄ")
Set sh2 = Worksheets("貼り付け先ｼｰﾄ")
r2 = 1
With sh1
cmax = .Cells(1, Columns.Count).End(xlToLeft).Column
For r1 = 2 To .Cells(Rows.Count, 1).End(xlUp).Row

sdate = .Cells(r1, 21)

For c = 25 To cmax Step 5
r2 = r2 + 1

'A列～U列は元ｼｰﾄの1行目を、12行同じ内容でコピペ
sh2.Range(sh2.Cells(r2, 1), sh2.Cells(r2, 20)).Value = .Range(.Cells(r1, 1), .Cells(r1, 20)).Value

'V列は、2019/4/1、2019/5/1、、、2020/3/1と月ごとに12行入力
sh2.Cells(r2, 21) = DateAdd("m", Int((c - 5) / 3), sdate)

'元ｼｰﾄのZ～CG列の、60（5×12）列を、貼り付け先シートの５（W~AA）列×12行でコピペ
sh2.Range(sh2.Cells(r2, 22), sh2.Cells(r2, 26)).Value = .Range(.Cells(r1, c), .Cells(r1, c + 5)).Value
Next c

Next r1

End With
Application.ScreenUpdating = True
End Sub

質問者からの補足コメント

• 

  ありがとうございます。。
  V列の処理についてご指摘を基に再検討し下記を書いてみたのですが、
  ★のところでエラーが出て処理ができません。。
  
  エラーの原因になっているところがもしお分かりでしたら、
  改善方針をご教示いただけますと非常に助かります。
  初心者なもので、基本的なことが間違っていたら申し訳ないです
  
  For r3 = 2 To sh1.Cells(Rows.Count, 1).End(xlDown).Row Step 12　★
  '基準になる「2019/4/1」を書き込む
  sh2.Cells(r3, 22) = "2019/4/1"
  
  '「2019/4/1」の下1～11行に「2019/5/1～2020/3/1」を書き込む
  For i = 1 To 11
  sh2.Cells(r2, 22) = DateAdd("m", i, Cells(r3, 22))
  Next i
  Next r3

  No.5の回答に寄せられた補足コメントです。 補足日時：2020/05/22 10:49

• ご助言ありがとうございます！
  指摘の通り、STEP箇所が誤っていたので再検討し、今のV列に関する記述は以下です
  V列について単体でマクロを立てて実行してみたところ★で、「オーバーフロー」と出ます。
  この原因についてもしお分かりでしたらご教示いただけると幸いです。。
  
  'sh1の最終行の行数を取得
  max = sh1.Cells(Rows.Count, 1).End(xlDown).Row ★
  'sh2で2019/4/1を入れたいのは、２行目から12行おきに、sh2の最終行（sh1最終行×12）回
  For r1 = 2 To rmax * 12 Step 12
  sh2.Cells(r1, 22) = "2019/4/1"
  For i = 1 To 11
  sh2.Cells(r1 + i, 22) = DateAdd("m", i, Cells(r1, 22))
  Next i
  Next r1

  No.6の回答に寄せられた補足コメントです。 補足日時：2020/05/22 12:09

• 恐れ入ります。。上記オーバーフローについては、rmaxをLongで定義したところ、解決しました。。
  しかし、今度は「オブジェクト定義のエラー」と出て、ｼｰﾄを見てみると、延々と2019/4/1が12行おきに記入されています。
  解決方法について、ご助言をいただけますと幸いです。
  
  rmax = sh1.Cells(Rows.Count, 1).End(xlDown).Row
  For r1 = 2 To rmax * 12 Step 12
  sh2.Cells(r1, 22) = "2019/4/1"　★
  For i = 1 To 11
  sh2.Cells(r1 + i, 22) = DateAdd("m", i, Cells(r1, 22))
  Next i
  Next r1

    補足日時：2020/05/22 12:24

No.10 ベストアンサー 回答者： めぐみん_ 回答日時： 2020/05/22 12:49

私なら

rmax = sh1.Cells(Rows.Count, 1).End(xlDown).Row
For r1 = 2 To rmax * 12 Step 12
'sh2.Cells(r1, 22) = "2019/4/1"　★削除
For i = 0 To 11
sh2.Cells(r1 + i, 22) = DateAdd("m", i, Cells(r1, 22))
Next i
Next r1

としますかね。
ただ Cells(r1,22)がアクティブシートなのか否かでシート名を明確にするかどうかが決まりどころかも。

この回答へのお礼

ありがとうございます。。。。。。
ご教示いただいた記述を理解してから自分の書いたものを見直してみたら、誤っていた内容が見えてきました。
また、無事やりたかった動きも実現することができました！本当に。ありがとうございます。
自分でもきちんと勉強してみます。

お礼日時：2020/05/22 21:01

No.9 回答者： Qchan1962 回答日時： 2020/05/22 12:42

rmax = sh1.Cells(Rows.Count, 1).End(xlDown).Row

これで本当に良いのですか？
rmax * 12 　存在しない行数になってませんか？

＃７を確認されてください。

No.8 回答者： Qchan1962 回答日時： 2020/05/22 12:17

補足について　変数宣言を　r3 As Integer　から　r3 As Long　にしてください。

No.7 回答者： Qchan1962 回答日時： 2020/05/22 12:13

＞For r3 = 2 To sh1.Cells(Rows.Count, 1).End(xlDown).Row Step 12　★

エラーの原因は、これだけではわからないのですが、End(xlDown)なのでRows.CountからEnd(xlDown)は、ダメではないでしょうか（結果シート最終行）
この場合、実行がされると、他の部分は分かりませんが、それなりの時間がかかるかと思います

.Cells(1,"A").End(xlDown).Row　みたいにしないと、、A1セルからCtrl+↓キーを押した時の.Row　行番号
もし、最終行から（Rows.Count）から上のセルを求めたいなら、.Cells(Rows.Count, 1).End(xlUp).Row になります。（そこには値が入っています）

更に、sh2.Cells(r2, 22) = DateAdd("m", i, Cells(r3, 22))　も
r2の値推移が不明ですが、For i = 1 To 11　のループ内にr2変数の変化が無ければ、同じ場所にDateAdd("m", i, Cells(r3, 22))が書き込まれ
結果、sh2.Cells(r2, 22) = DateAdd("m", 11, Cells(r3, 22))　を一度行ったのと同じになります。

あと、shを分けて考えられていると思いますので、最終的にまとめるとしても、検証時は、
CellsやRangeの前にシートを明示するようにした方が良いです。 DateAdd("m", 11, 　この部分　Cells(r3, 22))

'「2019/4/1」の下1～11行に「2019/5/1～2020/3/1」を書き込む
上のr3のループを除くとこんな感じ
For i = 1 To 11
sh2.Cells(r3+i, 22) = DateAdd("m", i, sh2.Cells(r3, 22))　 sh2.Cells(r3, 22)の下に書き込まれて行く
Next i
先のご質問コードについては、考えに入れていません。

No.6 回答者： めぐみん_ 回答日時： 2020/05/22 11:25

sh1って元のシートでしょ？

エラーの内容が情報として必要ですけど、何故A列をstepしてるのかが又ブック（シート）の構成がかわったのかな？

No.5 回答者： Qchan1962 回答日時： 2020/05/21 22:40

＞・貼り付け先のV列が全て「1900/1/0」

＞sh2.Cells(r2, 21) = DateAdd("m", Int((c - 5) / 3), sdate)
右辺を置いとくとしてsh2.Cells(r2, 21　は、U列では無いでしょうか？
列移動を変数でしないのならば、Cellsはこのように書く事も出来ます。
Cslle(row,"V")
正しい書き方かは、置いといて整理する為には、試す価値はあります。
先のResizeと合わせれば、意外と範囲設定も容易ですし、Offsetを使えば変数移動にも判りやすく対応します。（好き嫌いはありますが）

右辺に関してInt((25- 5) / 3)が求めたい数値なのか？わかりません。イミディエイトウィンドウやローカルウインドウ、
メッセージボックスでも良いので確認してみてはいかがでしょう。

No.4 回答者： fujillin 回答日時： 2020/05/21 22:34

こんばんは

申し訳ありませんが、回答ではありません。

似たようなご質問を繰り返していらっしゃいますが、質問のたびにセルの位置や対象となるセル数がかわっているようです。
変わったことでその前の回答が生きずに、修正して失敗なさっているように見受けられます。

質問の前に、まず、きちんと整理をなさっておいてから、セル範囲や位置が確定できるように質問をなさった方が、目的には早くたどり着けると思いますよ。
具体的なコードを求めるのであれば、コードはセルの範囲や位置に依存するものになりますので。

No.3 回答者： Qchan1962 回答日時： 2020/05/21 22:18

こんばんは、

多分ここは、、と思い書いてしまいそうですが、敢えてアドバイスにとどめます。
＞・A列～U列が、貼り付け先で13行複製されている（12行が理想）&13行目のW~AA列は空欄
多分、範囲指定が迷子になっているのだと思います。
範囲などを整理して、.Resizeなどを使われた方が良いと思います。おそらく、それだけで判りやすくなり
行の移動などセル配置も整理でき理解しやすくなるのではないでしょうか。

ご存知かもしれませんが、Resize　参考サイト　https://excelwork.info/excel/vbaresize/

この回答へのお礼

ご指摘を基に見直し、無事13行複製される現象は改善できました！ありがとうございます。。。

お礼日時：2020/05/22 10:51

No.2 回答者： めぐみん_ 回答日時： 2020/05/21 22:00

もう１つは cmax が本当に求めている値になっているのかデバッグで確認ですかね。

No.1 回答者： めぐみん_ 回答日時： 2020/05/21 21:28

・貼り付け先のV列が全て「1900/1/0」

これで気になるとしたら、

DateAdd("m", Int((c - 5) / 3), sdate)

ループで c が変化していく際に『本当に求めたい結果がこの計算で出てる？』と言う事でしょうかね。
デバッグでイミディエイトウィンドウなどの扱いを知ってれば、表示させて確認できるでしょ。
省略した内容の質問で得られた回答をそのまま使っているからおかしくなっているとかではなくて？

For c = 25 To cmax Step 5

であれば

DateAdd("m", Int((c - 25) / 5), sdate)

ではないかな？
これＶＢＡよりも算数のレベル位と思うよ。
c がどのように変化していくのかを紙に書くなりシートに打ち込むなりすれば見えてくるかと。

最初からちゃんとしたデータ範囲を提示しておけば回答者も最初の回答で済んだのに。
と思いますよ。（と言っておいて違ったら初級レベルのボケジジィと思ってくださいな）

この回答へのお礼

ありがとうございます。
まず記述の見直し&DateAddについて学ぶところからやってみようと思います。
こういった場では、確かに正確な情報をご提示することが、双方にとってベストですね。今後は出せる範囲で元データのことは正確に書いていこうと思います。ご親切にありがとうございます！

お礼日時：2020/05/22 10:53