teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

1

追記

2021/02/16 04:18

投稿

jinoji
jinoji

スコア4592

answer CHANGED
@@ -43,4 +43,57 @@
43
43
  Next
44
44
 
45
45
  End Sub
46
+ ```
47
+
48
+ ---
49
+ <追記>
50
+ 同じシートに書き出す場合はこんな感じだと思います。
51
+
52
+ ```VBA
53
+ Sub Sample2()
54
+
55
+ Dim moto As Worksheet
56
+ Dim lastRow, i
57
+
58
+ Set moto = Sheets("元シート")
59
+ lastRow = moto.Cells(Rows.Count, 2).End(xlUp).Row
60
+
61
+ Dim saki As Worksheet, outRow As Long
62
+
63
+ Set saki = Sheets.Add(, moto) 'その場で作るならこちら
64
+ ' Set saki = Sheets("別シート1") '先に用意しておくならこちら
65
+
66
+ moto.Range("B1:D1").Copy saki.Range("A1:C1")
67
+ outRow = 2
68
+
69
+
70
+ For i = 2 To lastRow
71
+ Dim startDate As Date
72
+ Dim endDate As Date
73
+ Dim repeatCount As Long
74
+
75
+ startDate = moto.Cells(i, 3)
76
+ If IsEmpty(moto.Cells(i, 4)) Then
77
+ endDate = Date
78
+ Else
79
+ endDate = moto.Cells(i, 4)
80
+ End If
81
+ repeatCount = DateDiff("m", startDate, endDate)
82
+
83
+ Dim j As Long
84
+
85
+ For j = 0 To repeatCount
86
+ saki.Cells(outRow, 1) = moto.Cells(i, 2)
87
+ saki.Cells(outRow, 2) = DateAdd("m", j, moto.Cells(i, 3))
88
+ saki.Cells(outRow, 3) = moto.Cells(i, 4)
89
+ outRow = outRow + 1
90
+ Next
91
+ Next
92
+
93
+ With saki.UsedRange
94
+ .NumberFormatLocal = "yyyy/m/d"
95
+ .EntireColumn.AutoFit
96
+ End With
97
+
98
+ End Sub
46
99
  ```