Q&A
エクセルのマクロのことなら、タグに Excel と VBA を追加してください。
マクロを使用して下記繰り返し作業を自動化することを考えています。
例えば①の場合2010/6,2020/7/,2020/8,2020/9の様に契約日～解約日まで1が月ごとに'別シート1'に契約レコード自動作成
②の場合も同様に契約日～今日まで1カ月ごとに'別シート2'に契約レコード自動作成を繰り返す
マクロをほぼ使ったことがなく上記設定可能なのか、マクロの使い方について教えていただけないでしょうか。
コピー＆ペーストは可能かと思いますが、条件を指定して上記の様な操作が可能なのかいろいろググって試行錯誤してみたものの、情報が出てこなかったためご質問させてください。
どうぞよろしくお願いいたします。
＜追記＞
皆さま迅速なご返信ありがとうございます。
頂いた同じシートに書き出す場合のVBAを参考にして追加要件をVBAに付け加えさせていただきましたが一部、想定道理の挙動をしない為、アドバイスいただけると助かります。
’契約件数’を1,2の様な数値で取得したいのですが結果を確認した所’1900/1/1’といった日付形式で値が出力されてしまいします。恐らく下記箇所が問題化と思うのですが、修正方法についてご教示いただけますと幸いです。
問題箇所：saki.Cells(outRow, 3) = moto.Cells(i, 3)
試してみたもの：saki.Cells(outRow, 3) = moto.Cells(3),saki.Cells(3) = moto.Cells(3)
どうぞよろしくお願いいたします。
元シート
マクロ実行結果
VBA
1Sub Sample2() 2 Dim moto As Worksheet 3 Dim lastRow, i 4 Set moto = Sheets("元シート") 5 lastRow = moto.Cells(Rows.Count, 2).End(xlUp).Row 6 Dim saki As Worksheet, outRow As Long 7 Set saki = Sheets.Add(, moto) 8 moto.Range("A1:AB1").Copy saki.Range("A1:AB1") 9 outRow = 2 10 For i = 2 To lastRow 11 Dim startDate As Date 12 Dim endDate As Date 13 Dim repeatCount As Long 14 startDate = moto.Cells(i, 4) 15 If IsEmpty(moto.Cells(i, 5)) Then 16 endDate = Date 17 Else 18 endDate = moto.Cells(i, 2) 19 End If 20 repeatCount = DateDiff("m", startDate, endDate) 21 Dim j As Long 22 For j = 0 To repeatCount 23 saki.Cells(outRow, 1) = DateAdd("m", j, moto.Cells(i, 1)) 24 saki.Cells(outRow, 2) = moto.Cells(i, 2) 25 saki.Cells(outRow, 3) = moto.Cells(i, 3) 26 saki.Cells(outRow, 4) = moto.Cells(i, 4) 27 saki.Cells(outRow, 5) = moto.Cells(i, 5) 28 saki.Cells(outRow, 6) = moto.Cells(i, 6) 29 saki.Cells(outRow, 7) = moto.Cells(i, 7) 30 saki.Cells(outRow, 8) = moto.Cells(i, 8) 31 saki.Cells(outRow, 9) = moto.Cells(i, 9) 32 saki.Cells(outRow, 10) = moto.Cells(i, 10) 33 saki.Cells(outRow, 11) = moto.Cells(i, 11) 34 saki.Cells(outRow, 12) = moto.Cells(i, 12) 35 saki.Cells(outRow, 13) = moto.Cells(i, 13) 36 saki.Cells(outRow, 14) = moto.Cells(i, 14) 37 saki.Cells(outRow, 15) = moto.Cells(i, 15) 38 saki.Cells(outRow, 16) = moto.Cells(i, 16) 39 saki.Cells(outRow, 17) = moto.Cells(i, 17) 40 saki.Cells(outRow, 18) = moto.Cells(i, 18) 41 saki.Cells(outRow, 19) = moto.Cells(i, 19) 42 saki.Cells(outRow, 20) = moto.Cells(i, 20) 43 saki.Cells(outRow, 21) = moto.Cells(i, 21) 44 saki.Cells(outRow, 22) = moto.Cells(i, 22) 45 saki.Cells(outRow, 23) = moto.Cells(i, 23) 46 outRow = outRow + 1 47 Next 48 Next 49 With saki.UsedRange 50 .NumberFormatLocal = "yyyy/m/d" 51 .EntireColumn.AutoFit 52 End With 53End Sub
あと、このままでは、丸投げの質問になり、推奨されない質問となってますので、下記辺りを参考にできるところまでコードを書いて、質問に追記してください。
http://officetanaka.net/excel/vba/cell/cell09.htm
繰り返し構文を使うことになると思いますので、下記も参考にしてください。
エクセルVBA３つループ処理For文・Do~While文・Do~Until文の使い分け
https://tonari-it.com/excel-vba-loop-3situation/
日付の加算は下記を参考に。
VBA DateAdd 関数
https://www.tipsfound.com/vba/05dateadd
お世話になります。
いただいたURL参考にさせていただきます。
また、質問への修正依頼等ご指摘ありがとうございます。
回答1件
0
ベストアンサー
おおよそこんな感じで出来ると思います。
各行で何をしているのかを読み解いてみてください。
VBA
1Sub sample() 2 3 Dim moto As Worksheet 4 Dim lastRow, i 5 6 Set moto = Sheets("元シート") 7 lastRow = moto.Cells(Rows.Count, 2).End(xlUp).Row 8 9 For i = 2 To lastRow 10 Dim startDate As Date 11 Dim endDate As Date 12 Dim repeatCount As Long 13 14 startDate = moto.Cells(i, 3) 15 If IsEmpty(moto.Cells(i, 4)) Then 16 endDate = Date 17 Else 18 endDate = moto.Cells(i, 4) 19 End If 20 repeatCount = DateDiff("m", startDate, endDate) 21 22 Dim saki As Worksheet 23 Set saki = Sheets.Add(, Sheets(Sheets.Count)) 24 25 saki.Name = moto.Cells(i, 2) 26 27 moto.Range("B1:D1").Copy saki.Range("A1:C1") 28 29 Dim j 30 For j = 0 To repeatCount 31 saki.Cells(2 + j, 1) = moto.Cells(i, 2) 32 saki.Cells(2 + j, 2) = DateAdd("m", j, moto.Cells(i, 3)) 33 saki.Cells(2 + j, 3) = moto.Cells(i, 4) 34 Next 35 With saki.UsedRange 36 .NumberFormatLocal = "yyyy/m/d" 37 .EntireColumn.AutoFit 38 End With 39 Next 40 41End Sub
＜追記＞
同じシートに書き出す場合はこんな感じだと思います。
VBA
1Sub Sample2() 2 3 Dim moto As Worksheet 4 Dim lastRow, i 5 6 Set moto = Sheets("元シート") 7 lastRow = moto.Cells(Rows.Count, 2).End(xlUp).Row 8 9 Dim saki As Worksheet, outRow As Long 10 11 Set saki = Sheets.Add(, moto) 'その場で作るならこちら 12' Set saki = Sheets("別シート1") '先に用意しておくならこちら 13 14 moto.Range("B1:D1").Copy saki.Range("A1:C1") 15 outRow = 2 16 17 18 For i = 2 To lastRow 19 Dim startDate As Date 20 Dim endDate As Date 21 Dim repeatCount As Long 22 23 startDate = moto.Cells(i, 3) 24 If IsEmpty(moto.Cells(i, 4)) Then 25 endDate = Date 26 Else 27 endDate = moto.Cells(i, 4) 28 End If 29 repeatCount = DateDiff("m", startDate, endDate) 30 31 Dim j As Long 32 33 For j = 0 To repeatCount 34 saki.Cells(outRow, 1) = moto.Cells(i, 2) 35 saki.Cells(outRow, 2) = DateAdd("m", j, moto.Cells(i, 3)) 36 saki.Cells(outRow, 3) = moto.Cells(i, 4) 37 outRow = outRow + 1 38 Next 39 Next 40 41 With saki.UsedRange 42 .NumberFormatLocal = "yyyy/m/d" 43 .EntireColumn.AutoFit 44 End With 45 46End Sub
投稿2021/02/14 04:26
編集2021/02/16 04:18
総合スコア4592
jinojiさんご回答ありがとうございます！！！
ご連絡が遅くなり申し訳ございません。
頂いたVBAを自分の環境で実装した所、やりたい繰り返し作業が一瞬完了いたしました！
自分で4日悩んで解決できなかったマクロの組み方がjinojiさんのお陰で3時間で解決出来てとても感謝しています。ご教示ありがとうございます。
追加の質問になってしまうのですが、'別シート1' '別シート2'と分けてコピー＆ペーストしていた所をまとめて'別シート1'にコピー＆ペーストする事は可能でしょうか？
各行で何をしているのかを読み解いて自分でVBAを改修出来るように試行錯誤しているのですが、中々上手く行かず、、、恐れ入りますがご相談させていただければ幸いです。
どうぞよろしくお願いいたします。
追加質問について上の回答欄に追記しました。
jinojiさん迅速なご回答ありがとうございます！
周りに有識者がおらず、1人でコピペから学んでいるところなのでとても助かっております…！
VBAを使って実装方法のご教示ありがとうございます。
頂いたVBA活用させていただきます！！！
契約件数が日付形式になってしまうのは、
With saki.UsedRange
.NumberFormatLocal = "yyyy/m/d"
.EntireColumn.AutoFit
End With
のところが原因です。
saki.UsedRange（書き出し先シートの使用されているセル範囲）の表示形式をまとめて日付形式にしているため、そのような結果になっています。
一度その部分を消して実行してみてください。
jinojiさんご回答ありがとうございます！
アドバイスいただいた通り.NumberFormatLocal = "yyyy/m/d"を消して実行した所、契約件数が数字で取得できました。ありがとうございます！
jinojiさんお世話になっております！！！
私事で恐縮ですが、アドバイスいただいたVBAが元データによってエラーが発生する様で修正方法についてもしご存知でしたら再度アドバイスいただけますでしょうか。
下記に発生したエラー詳細を記載させてただきましたのでご確認いただけるととても助かります…！
https://teratail.com/questions/323070
どうぞよろしくお願いいたします。
あなたの回答
tips
プレビュー
