回答編集履歴

1

追記

2021/02/16 04:18

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -89,3 +89,109 @@
89
89
  End Sub
90
90
 
91
91
  ```
92
+
93
+
94
+
95
+ ---
96
+
97
+ <追記>
98
+
99
+ 同じシートに書き出す場合はこんな感じだと思います。
100
+
101
+
102
+
103
+ ```VBA
104
+
105
+ Sub Sample2()
106
+
107
+
108
+
109
+ Dim moto As Worksheet
110
+
111
+ Dim lastRow, i
112
+
113
+
114
+
115
+ Set moto = Sheets("元シート")
116
+
117
+ lastRow = moto.Cells(Rows.Count, 2).End(xlUp).Row
118
+
119
+
120
+
121
+ Dim saki As Worksheet, outRow As Long
122
+
123
+
124
+
125
+ Set saki = Sheets.Add(, moto) 'その場で作るならこちら
126
+
127
+ ' Set saki = Sheets("別シート1") '先に用意しておくならこちら
128
+
129
+
130
+
131
+ moto.Range("B1:D1").Copy saki.Range("A1:C1")
132
+
133
+ outRow = 2
134
+
135
+
136
+
137
+
138
+
139
+ For i = 2 To lastRow
140
+
141
+ Dim startDate As Date
142
+
143
+ Dim endDate As Date
144
+
145
+ Dim repeatCount As Long
146
+
147
+
148
+
149
+ startDate = moto.Cells(i, 3)
150
+
151
+ If IsEmpty(moto.Cells(i, 4)) Then
152
+
153
+ endDate = Date
154
+
155
+ Else
156
+
157
+ endDate = moto.Cells(i, 4)
158
+
159
+ End If
160
+
161
+ repeatCount = DateDiff("m", startDate, endDate)
162
+
163
+
164
+
165
+ Dim j As Long
166
+
167
+
168
+
169
+ For j = 0 To repeatCount
170
+
171
+ saki.Cells(outRow, 1) = moto.Cells(i, 2)
172
+
173
+ saki.Cells(outRow, 2) = DateAdd("m", j, moto.Cells(i, 3))
174
+
175
+ saki.Cells(outRow, 3) = moto.Cells(i, 4)
176
+
177
+ outRow = outRow + 1
178
+
179
+ Next
180
+
181
+ Next
182
+
183
+
184
+
185
+ With saki.UsedRange
186
+
187
+ .NumberFormatLocal = "yyyy/m/d"
188
+
189
+ .EntireColumn.AutoFit
190
+
191
+ End With
192
+
193
+
194
+
195
+ End Sub
196
+
197
+ ```