質問編集履歴

2

皆さま迅速なご返信ありがとうございます。 頂いた同じシートに書き出す場合のVBAを参考にして追加要件をVBAに付け加えさせていただきましたが一部、想定道理の挙動をしない為、アドバイスいただけると助かり

2021/02/16 11:30

投稿

Rinriinrinrin
Rinriinrinrin

スコア13

test CHANGED
File without changes
test CHANGED
@@ -23,3 +23,141 @@
23
23
 
24
24
 
25
25
  どうぞよろしくお願いいたします。
26
+
27
+
28
+
29
+ <追記>
30
+
31
+ 皆さま迅速なご返信ありがとうございます。
32
+
33
+ 頂いた同じシートに書き出す場合のVBAを参考にして追加要件をVBAに付け加えさせていただきましたが一部、想定道理の挙動をしない為、アドバイスいただけると助かります。
34
+
35
+ ’契約件数’を1,2の様な数値で取得したいのですが結果を確認した所’1900/1/1’といった日付形式で値が出力されてしまいします。恐らく下記箇所が問題化と思うのですが、修正方法についてご教示いただけますと幸いです。
36
+
37
+ 問題箇所:saki.Cells(outRow, 3) = moto.Cells(i, 3)
38
+
39
+ 試してみたもの:saki.Cells(outRow, 3) = moto.Cells(3),saki.Cells(3) = moto.Cells(3)
40
+
41
+
42
+
43
+ どうぞよろしくお願いいたします。
44
+
45
+
46
+
47
+ **元シート**
48
+
49
+ ![イメージ説明](416b704ed43e940d8dbd6f6be671699c.png)
50
+
51
+ **マクロ実行結果**
52
+
53
+ ![イメージ説明](641613c4b2c538610827dc51d1152452.png)
54
+
55
+ ```VBA
56
+
57
+ Sub Sample2()
58
+
59
+ Dim moto As Worksheet
60
+
61
+ Dim lastRow, i
62
+
63
+ Set moto = Sheets("元シート")
64
+
65
+ lastRow = moto.Cells(Rows.Count, 2).End(xlUp).Row
66
+
67
+ Dim saki As Worksheet, outRow As Long
68
+
69
+ Set saki = Sheets.Add(, moto)
70
+
71
+ moto.Range("A1:AB1").Copy saki.Range("A1:AB1")
72
+
73
+ outRow = 2
74
+
75
+ For i = 2 To lastRow
76
+
77
+ Dim startDate As Date
78
+
79
+ Dim endDate As Date
80
+
81
+ Dim repeatCount As Long
82
+
83
+ startDate = moto.Cells(i, 4)
84
+
85
+ If IsEmpty(moto.Cells(i, 5)) Then
86
+
87
+ endDate = Date
88
+
89
+ Else
90
+
91
+ endDate = moto.Cells(i, 2)
92
+
93
+ End If
94
+
95
+ repeatCount = DateDiff("m", startDate, endDate)
96
+
97
+ Dim j As Long
98
+
99
+ For j = 0 To repeatCount
100
+
101
+ saki.Cells(outRow, 1) = DateAdd("m", j, moto.Cells(i, 1))
102
+
103
+ saki.Cells(outRow, 2) = moto.Cells(i, 2)
104
+
105
+ saki.Cells(outRow, 3) = moto.Cells(i, 3)
106
+
107
+ saki.Cells(outRow, 4) = moto.Cells(i, 4)
108
+
109
+ saki.Cells(outRow, 5) = moto.Cells(i, 5)
110
+
111
+ saki.Cells(outRow, 6) = moto.Cells(i, 6)
112
+
113
+ saki.Cells(outRow, 7) = moto.Cells(i, 7)
114
+
115
+ saki.Cells(outRow, 8) = moto.Cells(i, 8)
116
+
117
+ saki.Cells(outRow, 9) = moto.Cells(i, 9)
118
+
119
+ saki.Cells(outRow, 10) = moto.Cells(i, 10)
120
+
121
+ saki.Cells(outRow, 11) = moto.Cells(i, 11)
122
+
123
+ saki.Cells(outRow, 12) = moto.Cells(i, 12)
124
+
125
+ saki.Cells(outRow, 13) = moto.Cells(i, 13)
126
+
127
+ saki.Cells(outRow, 14) = moto.Cells(i, 14)
128
+
129
+ saki.Cells(outRow, 15) = moto.Cells(i, 15)
130
+
131
+ saki.Cells(outRow, 16) = moto.Cells(i, 16)
132
+
133
+ saki.Cells(outRow, 17) = moto.Cells(i, 17)
134
+
135
+ saki.Cells(outRow, 18) = moto.Cells(i, 18)
136
+
137
+ saki.Cells(outRow, 19) = moto.Cells(i, 19)
138
+
139
+ saki.Cells(outRow, 20) = moto.Cells(i, 20)
140
+
141
+ saki.Cells(outRow, 21) = moto.Cells(i, 21)
142
+
143
+ saki.Cells(outRow, 22) = moto.Cells(i, 22)
144
+
145
+ saki.Cells(outRow, 23) = moto.Cells(i, 23)
146
+
147
+ outRow = outRow + 1
148
+
149
+ Next
150
+
151
+ Next
152
+
153
+ With saki.UsedRange
154
+
155
+ .NumberFormatLocal = "yyyy/m/d"
156
+
157
+ .EntireColumn.AutoFit
158
+
159
+ End With
160
+
161
+ End Sub
162
+
163
+ ```

1

ご指摘いただいた’Excel’,’VBA’タグ追記いたしました!

2021/02/16 11:30

投稿

Rinriinrinrin
Rinriinrinrin

スコア13

test CHANGED
File without changes
test CHANGED
File without changes