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

編集履歴

質問編集履歴

7

文言の修正

2020/10/01 14:48

投稿

icecleam
icecleam

スコア46

title CHANGED
File without changes
body CHANGED
@@ -3,6 +3,7 @@
3
3
 
4
4
  何卒、よろしくお願いします。
5
5
 
6
+
6
7
  実現したいこと
7
8
  --------------
8
9
  このような手順で処理を行っていこうと考えています。

6

文言の修正

2020/10/01 14:48

投稿

icecleam
icecleam

スコア46

title CHANGED
File without changes
body CHANGED
@@ -27,15 +27,10 @@
27
27
  上記「実現したいこと」記載の
28
28
  「各行で年月の値を取得し、最小値と最大値を求める」処理の方法がわかりません。→解決済み
29
29
 
30
- ご回答いただいた内容を参照して、ソースを作成し直したが
30
+ ご回答いただいた内容を参照して、ソースを作成し直したが（現在まで完成しているコード）
31
31
  「オブジェクト変数またはWithブロック変数が設定されていません」
32
32
  という内容のエラーメッセージが出てしまう。
33
33
 
34
- 下記のソースコード
35
- '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
36
- 部分
37
-
38
-
39
34
  現在まで完成しているコード
40
35
  ---------
41
36
 

5

ソースの編集

2020/10/01 13:52

投稿

icecleam
icecleam

スコア46

title CHANGED
File without changes
body CHANGED
@@ -25,8 +25,12 @@
25
25
  困っている事
26
26
  ---------
27
27
  上記「実現したいこと」記載の
28
- 「各行で年月の値を取得し、最小値と最大値を求める」処理の方法がわかりません。
28
+ 「各行で年月の値を取得し、最小値と最大値を求める」処理の方法がわかりません。→解決済み
29
29
 
30
+ ご回答いただいた内容を参照して、ソースを作成し直したが
31
+ 「オブジェクト変数またはWithブロック変数が設定されていません」
32
+ という内容のエラーメッセージが出てしまう。
33
+
30
34
  下記のソースコード
31
35
  '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
32
36
  部分
@@ -38,34 +42,61 @@
38
42
  ```VBA
39
43
  Sub SheetTenki()
40
44
  '
41
- Dim ec As Long '年月の一番左から一番右までを取得
45
+ Dim ec As Long '年月の一番左から一番右までを取得
42
- Dim lngFromRowsNo As Long ' 検索する行位置
46
+ Dim lngFromRowsNo As Long ' 検索する行位置
43
- Dim lngToRowsNo As Long ' 書きこむ行位置
47
+ Dim lngToRowsNo As Long ' 書きこむ行位置
44
- Dim wsFrom As Worksheet ' 取得側Excelシート
48
+ Dim wsFrom As Worksheet ' 取得側Excelシート
45
- Dim wsTo As Worksheet ' 設定側Excelシート
49
+ Dim wsTo As Worksheet ' 設定側Excelシート
46
50
 
51
+ Dim datMax As Date '日付最大値
52
+ Dim datMin As Date '日付最小値
53
+ Dim enddatMax As Date ' 最終的な日付最大値
54
+ Dim enddatMin As Date '最終的な日付最小値
55
+ Dim ToColumnNo As Long
56
+
57
+ enddatMax = #1/1/100# '日付最大値に最小値を設定
58
+ enddatMin = #1/1/9999# '日付最最少値に最大値を設定
59
+ ToColumnNo = 4
60
+
61
+
62
+ 'シート"質問１"を選択
63
+ Set wsFrom = Worksheets("質問１")
47
64
 
65
+ 'D列を上から検索していき、yyyy/mm/dd形式のセルを抽出する
66
+ For lngFromRowsNo = 1 To wsFrom.UsedRange.Rows.Count
67
+ If IsDate(wsFrom.Cells(lngFromRowsNo, 4).Value) Then
68
+
48
- 'シート"質問１"を選択
69
+ '抽出した行の年月を値が含まれる最大まで（右側）取得
70
+ '?１は見込み合計を含まないため
71
+ ec = wsFrom.Cells(lngFromRowsNo, 4).End(xlToRight).Column - 1
72
+
73
+ '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
74
+ With WorksheetFunction
75
+ datMax = .Max(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
76
+ datMin = .Min(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
77
+ End With
78
+ 'どこに転記するか不明なのでとりあえずメッセージボックスに表示
79
+ 'MsgBox "最大値:" & datMax & " 最小値:" & datMin
80
+
49
- Sheets("質問１").Select
81
+ If enddatMin > datMin Then
82
+ enddatMin = datMin
83
+ End If
84
+ If enddatMax < datMax Then
85
+ enddatMax = datMax
86
+ End If
87
+
88
+ ' 次の行へ
89
+ lngToRowsNo = lngToRowsNo + 1
90
+
91
+ End If
92
+
93
+ Next lngFromRowsNo
50
94
 
51
- 'D列を上から検索していき、yyyy/mm/dd形式のセルを抽出する
52
- For lngFromRowsNo = 1 To wsFrom.UsedRange.Rows.Count
53
- If (Left(.Cells(lngFromRowsNo, 4).Value, 5) = "2020/" Or Left(.Cells(lngFromRowsNo, 4).Value, 5) = "2021/") Then
54
-
55
- '抽出した行の年月を値が含まれる最大まで（右側）取得
56
- '−１は見込み合計を含まないため
95
+ Do
57
- ec = wsTo.Cells(lngFromRowsNo, 4).End(xlToRight).Column - 1
96
+ wsTo.Cells(2, ToColumnNo).Value = enddatMin
58
-
59
-
60
- '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
61
-
62
-
63
-
64
- ' 次の行へ
65
- lngToRowsNo = lngToRowsNo + 1
97
+ ToColumnNo = ToColumnNo + 1 '次の列へ
98
+ enddatMin = DateAdd("m", 1, enddatMin) '一ヶ月後
99
+ Loop Until enddatMin > enddatMax
66
100
 
67
- End If
68
- Next lngFromRowsNo
69
-
70
101
  End Sub
71
102
  ```

4

ソースの削除

2020/10/01 13:09

投稿

icecleam
icecleam

スコア46

title CHANGED
File without changes
body CHANGED
@@ -32,11 +32,6 @@
32
32
  部分
33
33
 
34
34
 
35
- 追記のソースコード
36
- エラーメッセージ
37
- 「オブジェクト変数またはWithブロック変数が設定されていません」が出てきます。
38
-
39
-
40
35
  現在まで完成しているコード
41
36
  ---------
42
37
 
@@ -73,45 +68,4 @@
73
68
  Next lngFromRowsNo
74
69
 
75
70
  End Sub
76
- ```
77
-
78
- 追記
79
- ----
80
- 2020/9/28 13:17時点
81
- ```VBA
82
- Sub SheetTenki()
83
- '
84
- Dim ec As Long '年月の一番左から一番右までを取得
85
- Dim lngFromRowsNo As Long ' 検索する行位置
86
- Dim lngToRowsNo As Long ' 書きこむ行位置
87
- Dim wsFrom As Worksheet ' 取得側Excelシート
88
- Dim wsTo As Worksheet ' 設定側Excelシート
89
-
90
- Dim datMax As Date '日付最大値
91
- Dim datMin As Date '日付最小値
92
-
93
-
94
- 'シート"質問１"を選択
95
- Sheets("質問１").Select
96
-
97
- 'D列を上から検索していき、yyyy/mm/dd形式のセルを抽出する
98
- For lngFromRowsNo = 1 To wsFrom.UsedRange.Rows.Count
99
- If IsDate(wsFrom.Cells(lngFromRowsNo, 4).Value) Then
100
-
101
- '抽出した行の年月を値が含まれる最大まで（右側）取得
102
- '−１は見込み合計を含まないため
103
- ec = wsFrom.Cells(lngFromRowsNo, 4).End(xlToRight).Column - 1
104
-
105
- '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
106
- datMax = WorksheetFunction.Max(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
107
- datMin = WorksheetFunction.Min(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
108
-
109
- ' 次の行へ
110
- lngToRowsNo = lngToRowsNo + 1
111
-
112
- End If
113
- Next lngFromRowsNo
114
-
115
- End Sub
116
-
117
71
  ```

3

ソースの追加

2020/09/28 04:22

投稿

icecleam
icecleam

スコア46

title CHANGED
File without changes
body CHANGED
@@ -32,6 +32,11 @@
32
32
  部分
33
33
 
34
34
 
35
+ 追記のソースコード
36
+ エラーメッセージ
37
+ 「オブジェクト変数またはWithブロック変数が設定されていません」が出てきます。
38
+
39
+
35
40
  現在まで完成しているコード
36
41
  ---------
37
42
 
@@ -68,4 +73,45 @@
68
73
  Next lngFromRowsNo
69
74
 
70
75
  End Sub
76
+ ```
77
+
78
+ 追記
79
+ ----
80
+ 2020/9/28 13:17時点
81
+ ```VBA
82
+ Sub SheetTenki()
83
+ '
84
+ Dim ec As Long '年月の一番左から一番右までを取得
85
+ Dim lngFromRowsNo As Long ' 検索する行位置
86
+ Dim lngToRowsNo As Long ' 書きこむ行位置
87
+ Dim wsFrom As Worksheet ' 取得側Excelシート
88
+ Dim wsTo As Worksheet ' 設定側Excelシート
89
+
90
+ Dim datMax As Date '日付最大値
91
+ Dim datMin As Date '日付最小値
92
+
93
+
94
+ 'シート"質問１"を選択
95
+ Sheets("質問１").Select
96
+
97
+ 'D列を上から検索していき、yyyy/mm/dd形式のセルを抽出する
98
+ For lngFromRowsNo = 1 To wsFrom.UsedRange.Rows.Count
99
+ If IsDate(wsFrom.Cells(lngFromRowsNo, 4).Value) Then
100
+
101
+ '抽出した行の年月を値が含まれる最大まで（右側）取得
102
+ '−１は見込み合計を含まないため
103
+ ec = wsFrom.Cells(lngFromRowsNo, 4).End(xlToRight).Column - 1
104
+
105
+ '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく
106
+ datMax = WorksheetFunction.Max(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
107
+ datMin = WorksheetFunction.Min(Range(wsFrom.Cells(lngFromRowsNo, 4), wsFrom.Cells(lngFromRowsNo, ec)))
108
+
109
+ ' 次の行へ
110
+ lngToRowsNo = lngToRowsNo + 1
111
+
112
+ End If
113
+ Next lngFromRowsNo
114
+
115
+ End Sub
116
+
71
117
  ```

2

内容の修正

2020/09/28 04:19

投稿

icecleam
icecleam

スコア46

title CHANGED
File without changes
body CHANGED
@@ -25,7 +25,7 @@
25
25
  困っている事
26
26
  ---------
27
27
  上記「実現したいこと」記載の
28
- 「２行目の年月の値を取得し、最小値と最大値を求める」処理の方法がわかりません。
28
+ 「各行で年月の値を取得し、最小値と最大値を求める」処理の方法がわかりません。
29
29
 
30
30
  下記のソースコード
31
31
  '取得した年月の最大値と最小値を求めて、最小値から最大値までを1ヶ月間隔で転記していく

1

写真の修正

2020/09/27 17:21

投稿

icecleam
icecleam

スコア46

title CHANGED
File without changes
body CHANGED
@@ -12,7 +12,7 @@
12
12
  →無処理
13
13
 
14
14
  [質問１シート]２行目　D列の値がyyyy/mm/dd形式である
15
- →年月の値を取得し、最小値と最大値を求める
15
+ →年月の値を取得し、取得した全ての日付の最小値と最大値を求める
16
16
  ...
17
17
  以降、yyyy/mm/dd形式かそうでないかで処理の繰り返し
18
18
 
@@ -20,7 +20,7 @@
20
20
  ![イメージ説明](75811ae1c43d954cc5cfb9ce96cf6110.png)
21
21
 
22
22
  転記先
23
- ![イメージ説明](016ba830eb710e562a11fa74c9ff414e.png)
23
+ ![イメージ説明](612bd374f9950f79224e910d07e2c43a.png)
24
24
 
25
25
  困っている事
26
26
  ---------