teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップに関する質問VBA シート間の転記をする際に日付の最大値と最小値を求めて、1ヶ月ごとに転記していきたい。

編集履歴

質問編集履歴

7

文言の修正

2020/10/01 14:48

投稿

icecleam
icecleam

スコア46

test CHANGED
File without changes
test CHANGED
@@ -5,6 +5,8 @@
5
5
 
6
6
 
7
7
  何卒、よろしくお願いします。
8
+
9
+
8
10
 
9
11
 
10
12
 

6

文言の修正

2020/10/01 14:48

投稿

icecleam
icecleam

スコア46

test CHANGED
File without changes
test CHANGED
@@ -56,21 +56,11 @@
56
56
 
57
57
 
58
58
 
59
- ご回答いただいた内容を参照して、ソースを作成し直したが
59
+ ご回答いただいた内容を参照して、ソースを作成し直したが（現在まで完成しているコード）
60
60
 
61
61
  「オブジェクト変数またはWithブロック変数が設定されていません」
62
62
 
63
63
  という内容のエラーメッセージが出てしまう。
64
-
65
-
66
-
67
- 下記のソースコード
68
-
69
- '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
70
-
71
- 部分
72
-
73
-
74
64
 
75
65
 
76
66
 

5

ソースの編集

2020/10/01 13:52

投稿

icecleam
icecleam

スコア46

test CHANGED
File without changes
test CHANGED
@@ -52,7 +52,15 @@
52
52
 
53
53
  上記「実現したいこと」記載の
54
54
 
55
- 「各行で年月の値を取得し、最小値と最大値を求める」処理の方法がわかりません。
55
+ 「各行で年月の値を取得し、最小値と最大値を求める」処理の方法がわかりません。→解決済み
56
+
57
+
58
+
59
+ ご回答いただいた内容を参照して、ソースを作成し直したが
60
+
61
+ 「オブジェクト変数またはWithブロック変数が設定されていません」
62
+
63
+ という内容のエラーメッセージが出てしまう。
56
64
 
57
65
 
58
66
 
@@ -78,63 +86,117 @@
78
86
 
79
87
  '
80
88
 
81
- Dim ec As Long '年月の一番左から一番右までを取得
89
+ Dim ec As Long '年月の一番左から一番右までを取得
82
-
90
+
83
- Dim lngFromRowsNo As Long ' 検索する行位置
91
+ Dim lngFromRowsNo As Long ' 検索する行位置
84
-
92
+
85
- Dim lngToRowsNo As Long ' 書きこむ行位置
93
+ Dim lngToRowsNo As Long ' 書きこむ行位置
86
-
94
+
87
- Dim wsFrom As Worksheet ' 取得側Excelシート
95
+ Dim wsFrom As Worksheet ' 取得側Excelシート
88
-
96
+
89
- Dim wsTo As Worksheet ' 設定側Excelシート
97
+ Dim wsTo As Worksheet ' 設定側Excelシート
98
+
99
+
100
+
90
-
101
+ Dim datMax As Date '日付最大値
102
+
91
-
103
+ Dim datMin As Date '日付最小値
104
+
92
-
105
+ Dim enddatMax As Date ' 最終的な日付最大値
106
+
93
-
107
+ Dim enddatMin As Date '最終的な日付最小値
108
+
109
+ Dim ToColumnNo As Long
110
+
111
+
112
+
113
+ enddatMax = #1/1/100# '日付最大値に最小値を設定
114
+
115
+ enddatMin = #1/1/9999# '日付最最少値に最大値を設定
116
+
117
+ ToColumnNo = 4
118
+
119
+
120
+
121
+
94
122
 
95
123
  'シート"質問１"を選択
96
124
 
97
- Sheets("質問１").Select
98
-
99
-
100
-
101
- 'D列を上から検索していき、yyyy/mm/dd形式のセルを抽出する
102
-
103
- For lngFromRowsNo = 1 To wsFrom.UsedRange.Rows.Count
104
-
105
- If (Left(.Cells(lngFromRowsNo, 4).Value, 5) = "2020/" Or Left(.Cells(lngFromRowsNo, 4).Value, 5) = "2021/") Then
106
-
107
-
108
-
109
- '抽出した行の年月を値が含まれる最大まで（右側）取得
110
-
111
- '−１は見込み合計を含まないため
112
-
113
- ec = wsTo.Cells(lngFromRowsNo, 4).End(xlToRight).Column - 1
114
-
115
-
116
-
117
-
118
-
119
- '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
120
-
121
-
122
-
123
-
124
-
125
-
126
-
127
- ' 次の行へ
128
-
129
- lngToRowsNo = lngToRowsNo + 1
130
-
131
-
132
-
133
- End If
134
-
135
- Next lngFromRowsNo
136
-
137
-
125
+ Set wsFrom = Worksheets("質問１")
126
+
127
+
128
+
129
+ 'D列を上から検索していき、yyyy/mm/dd形式のセルを抽出する
130
+
131
+ For lngFromRowsNo = 1 To wsFrom.UsedRange.Rows.Count
132
+
133
+ If IsDate(wsFrom.Cells(lngFromRowsNo, 4).Value) Then
134
+
135
+
136
+
137
+ '抽出した行の年月を値が含まれる最大まで（右側）取得
138
+
139
+ '?１は見込み合計を含まないため
140
+
141
+ ec = wsFrom.Cells(lngFromRowsNo, 4).End(xlToRight).Column - 1
142
+
143
+
144
+
145
+ '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
146
+
147
+ With WorksheetFunction
148
+
149
+ datMax = .Max(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
150
+
151
+ datMin = .Min(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
152
+
153
+ End With
154
+
155
+ 'どこに転記するか不明なのでとりあえずメッセージボックスに表示
156
+
157
+ 'MsgBox "最大値:" & datMax & " 最小値:" & datMin
158
+
159
+
160
+
161
+ If enddatMin > datMin Then
162
+
163
+ enddatMin = datMin
164
+
165
+ End If
166
+
167
+ If enddatMax < datMax Then
168
+
169
+ enddatMax = datMax
170
+
171
+ End If
172
+
173
+
174
+
175
+ ' 次の行へ
176
+
177
+ lngToRowsNo = lngToRowsNo + 1
178
+
179
+
180
+
181
+ End If
182
+
183
+
184
+
185
+ Next lngFromRowsNo
186
+
187
+
188
+
189
+ Do
190
+
191
+ wsTo.Cells(2, ToColumnNo).Value = enddatMin
192
+
193
+ ToColumnNo = ToColumnNo + 1 '次の列へ
194
+
195
+ enddatMin = DateAdd("m", 1, enddatMin) '一ヶ月後
196
+
197
+ Loop Until enddatMin > enddatMax
198
+
199
+
138
200
 
139
201
  End Sub
140
202
 

4

ソースの削除

2020/10/01 13:09

投稿

icecleam
icecleam

スコア46

test CHANGED
File without changes
test CHANGED
@@ -61,16 +61,6 @@
61
61
  '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
62
62
 
63
63
  部分
64
-
65
-
66
-
67
-
68
-
69
- 追記のソースコード
70
-
71
- エラーメッセージ
72
-
73
- 「オブジェクト変数またはWithブロック変数が設定されていません」が出てきます。
74
64
 
75
65
 
76
66
 
@@ -149,85 +139,3 @@
149
139
  End Sub
150
140
 
151
141
  ```
152
-
153
-
154
-
155
- 追記
156
-
157
- ----
158
-
159
- 2020/9/28 13:17時点
160
-
161
- ```VBA
162
-
163
- Sub SheetTenki()
164
-
165
- '
166
-
167
- Dim ec As Long '年月の一番左から一番右までを取得
168
-
169
- Dim lngFromRowsNo As Long ' 検索する行位置
170
-
171
- Dim lngToRowsNo As Long ' 書きこむ行位置
172
-
173
- Dim wsFrom As Worksheet ' 取得側Excelシート
174
-
175
- Dim wsTo As Worksheet ' 設定側Excelシート
176
-
177
-
178
-
179
- Dim datMax As Date '日付最大値
180
-
181
- Dim datMin As Date '日付最小値
182
-
183
-
184
-
185
-
186
-
187
- 'シート"質問１"を選択
188
-
189
- Sheets("質問１").Select
190
-
191
-
192
-
193
- 'D列を上から検索していき、yyyy/mm/dd形式のセルを抽出する
194
-
195
- For lngFromRowsNo = 1 To wsFrom.UsedRange.Rows.Count
196
-
197
- If IsDate(wsFrom.Cells(lngFromRowsNo, 4).Value) Then
198
-
199
-
200
-
201
- '抽出した行の年月を値が含まれる最大まで（右側）取得
202
-
203
- '−１は見込み合計を含まないため
204
-
205
- ec = wsFrom.Cells(lngFromRowsNo, 4).End(xlToRight).Column - 1
206
-
207
-
208
-
209
- '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
210
-
211
- datMax = WorksheetFunction.Max(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
212
-
213
- datMin = WorksheetFunction.Min(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
214
-
215
-
216
-
217
- ' 次の行へ
218
-
219
- lngToRowsNo = lngToRowsNo + 1
220
-
221
-
222
-
223
- End If
224
-
225
- Next lngFromRowsNo
226
-
227
-
228
-
229
- End Sub
230
-
231
-
232
-
233
- ```

3

ソースの追加

2020/09/28 04:22

投稿

icecleam
icecleam

スコア46

test CHANGED
File without changes
test CHANGED
@@ -66,6 +66,16 @@
66
66
 
67
67
 
68
68
 
69
+ 追記のソースコード
70
+
71
+ エラーメッセージ
72
+
73
+ 「オブジェクト変数またはWithブロック変数が設定されていません」が出てきます。
74
+
75
+
76
+
77
+
78
+
69
79
  現在まで完成しているコード
70
80
 
71
81
  ---------
@@ -139,3 +149,85 @@
139
149
  End Sub
140
150
 
141
151
  ```
152
+
153
+
154
+
155
+ 追記
156
+
157
+ ----
158
+
159
+ 2020/9/28 13:17時点
160
+
161
+ ```VBA
162
+
163
+ Sub SheetTenki()
164
+
165
+ '
166
+
167
+ Dim ec As Long '年月の一番左から一番右までを取得
168
+
169
+ Dim lngFromRowsNo As Long ' 検索する行位置
170
+
171
+ Dim lngToRowsNo As Long ' 書きこむ行位置
172
+
173
+ Dim wsFrom As Worksheet ' 取得側Excelシート
174
+
175
+ Dim wsTo As Worksheet ' 設定側Excelシート
176
+
177
+
178
+
179
+ Dim datMax As Date '日付最大値
180
+
181
+ Dim datMin As Date '日付最小値
182
+
183
+
184
+
185
+
186
+
187
+ 'シート"質問１"を選択
188
+
189
+ Sheets("質問１").Select
190
+
191
+
192
+
193
+ 'D列を上から検索していき、yyyy/mm/dd形式のセルを抽出する
194
+
195
+ For lngFromRowsNo = 1 To wsFrom.UsedRange.Rows.Count
196
+
197
+ If IsDate(wsFrom.Cells(lngFromRowsNo, 4).Value) Then
198
+
199
+
200
+
201
+ '抽出した行の年月を値が含まれる最大まで（右側）取得
202
+
203
+ '−１は見込み合計を含まないため
204
+
205
+ ec = wsFrom.Cells(lngFromRowsNo, 4).End(xlToRight).Column - 1
206
+
207
+
208
+
209
+ '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
210
+
211
+ datMax = WorksheetFunction.Max(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
212
+
213
+ datMin = WorksheetFunction.Min(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
214
+
215
+
216
+
217
+ ' 次の行へ
218
+
219
+ lngToRowsNo = lngToRowsNo + 1
220
+
221
+
222
+
223
+ End If
224
+
225
+ Next lngFromRowsNo
226
+
227
+
228
+
229
+ End Sub
230
+
231
+
232
+
233
+ ```

2

内容の修正

2020/09/28 04:19

投稿

icecleam
icecleam

スコア46

test CHANGED
File without changes
test CHANGED
@@ -52,7 +52,7 @@
52
52
 
53
53
  上記「実現したいこと」記載の
54
54
 
55
- 「２行目の年月の値を取得し、最小値と最大値を求める」処理の方法がわかりません。
55
+ 「各行で年月の値を取得し、最小値と最大値を求める」処理の方法がわかりません。
56
56
 
57
57
 
58
58
 

1

写真の修正

2020/09/27 17:21

投稿

icecleam
icecleam

スコア46

test CHANGED
File without changes
test CHANGED
@@ -26,7 +26,7 @@
26
26
 
27
27
  [質問１シート]２行目　D列の値がyyyy/mm/dd形式である
28
28
 
29
- →年月の値を取得し、最小値と最大値を求める
29
+ →年月の値を取得し、取得した全ての日付の最小値と最大値を求める
30
30
 
31
31
  ...
32
32
 
@@ -42,7 +42,7 @@
42
42
 
43
43
  転記先
44
44
 
45
- ![イメージ説明](016ba830eb710e562a11fa74c9ff414e.png)
45
+ ![イメージ説明](612bd374f9950f79224e910d07e2c43a.png)
46
46
 
47
47
 
48
48