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

質問編集履歴

2

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

2021/02/16 11:30

投稿

Rinriinrinrin
Rinriinrinrin

スコア13

title CHANGED
File without changes
body CHANGED
@@ -10,4 +10,73 @@
10
10
 
11
11
  コピー&ペーストは可能かと思いますが、条件を指定して上記の様な操作が可能なのかいろいろググって試行錯誤してみたものの、情報が出てこなかったためご質問させてください。
12
12
 
13
- どうぞよろしくお願いいたします。
13
+ どうぞよろしくお願いいたします。
14
+
15
+ <追記>
16
+ 皆さま迅速なご返信ありがとうございます。
17
+ 頂いた同じシートに書き出す場合のVBAを参考にして追加要件をVBAに付け加えさせていただきましたが一部、想定道理の挙動をしない為、アドバイスいただけると助かります。
18
+ ’契約件数’を1,2の様な数値で取得したいのですが結果を確認した所’1900/1/1’といった日付形式で値が出力されてしまいします。恐らく下記箇所が問題化と思うのですが、修正方法についてご教示いただけますと幸いです。
19
+ 問題箇所:saki.Cells(outRow, 3) = moto.Cells(i, 3)
20
+ 試してみたもの:saki.Cells(outRow, 3) = moto.Cells(3),saki.Cells(3) = moto.Cells(3)
21
+
22
+ どうぞよろしくお願いいたします。
23
+
24
+ **元シート**
25
+ ![イメージ説明](416b704ed43e940d8dbd6f6be671699c.png)
26
+ **マクロ実行結果**
27
+ ![イメージ説明](641613c4b2c538610827dc51d1152452.png)
28
+ ```VBA
29
+ Sub Sample2()
30
+ Dim moto As Worksheet
31
+ Dim lastRow, i
32
+ Set moto = Sheets("元シート")
33
+ lastRow = moto.Cells(Rows.Count, 2).End(xlUp).Row
34
+ Dim saki As Worksheet, outRow As Long
35
+ Set saki = Sheets.Add(, moto)
36
+ moto.Range("A1:AB1").Copy saki.Range("A1:AB1")
37
+ outRow = 2
38
+ For i = 2 To lastRow
39
+ Dim startDate As Date
40
+ Dim endDate As Date
41
+ Dim repeatCount As Long
42
+ startDate = moto.Cells(i, 4)
43
+ If IsEmpty(moto.Cells(i, 5)) Then
44
+ endDate = Date
45
+ Else
46
+ endDate = moto.Cells(i, 2)
47
+ End If
48
+ repeatCount = DateDiff("m", startDate, endDate)
49
+ Dim j As Long
50
+ For j = 0 To repeatCount
51
+ saki.Cells(outRow, 1) = DateAdd("m", j, moto.Cells(i, 1))
52
+ saki.Cells(outRow, 2) = moto.Cells(i, 2)
53
+ saki.Cells(outRow, 3) = moto.Cells(i, 3)
54
+ saki.Cells(outRow, 4) = moto.Cells(i, 4)
55
+ saki.Cells(outRow, 5) = moto.Cells(i, 5)
56
+ saki.Cells(outRow, 6) = moto.Cells(i, 6)
57
+ saki.Cells(outRow, 7) = moto.Cells(i, 7)
58
+ saki.Cells(outRow, 8) = moto.Cells(i, 8)
59
+ saki.Cells(outRow, 9) = moto.Cells(i, 9)
60
+ saki.Cells(outRow, 10) = moto.Cells(i, 10)
61
+ saki.Cells(outRow, 11) = moto.Cells(i, 11)
62
+ saki.Cells(outRow, 12) = moto.Cells(i, 12)
63
+ saki.Cells(outRow, 13) = moto.Cells(i, 13)
64
+ saki.Cells(outRow, 14) = moto.Cells(i, 14)
65
+ saki.Cells(outRow, 15) = moto.Cells(i, 15)
66
+ saki.Cells(outRow, 16) = moto.Cells(i, 16)
67
+ saki.Cells(outRow, 17) = moto.Cells(i, 17)
68
+ saki.Cells(outRow, 18) = moto.Cells(i, 18)
69
+ saki.Cells(outRow, 19) = moto.Cells(i, 19)
70
+ saki.Cells(outRow, 20) = moto.Cells(i, 20)
71
+ saki.Cells(outRow, 21) = moto.Cells(i, 21)
72
+ saki.Cells(outRow, 22) = moto.Cells(i, 22)
73
+ saki.Cells(outRow, 23) = moto.Cells(i, 23)
74
+ outRow = outRow + 1
75
+ Next
76
+ Next
77
+ With saki.UsedRange
78
+ .NumberFormatLocal = "yyyy/m/d"
79
+ .EntireColumn.AutoFit
80
+ End With
81
+ End Sub
82
+ ```

1

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

2021/02/16 11:30

投稿

Rinriinrinrin
Rinriinrinrin

スコア13

title CHANGED
File without changes
body CHANGED
File without changes