teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップCSVに関する質問VBAでCSVをエクセル形式で開いたものに、さらにマクロを実行すると上手くいきません

編集履歴

回答編集履歴

4

修正

2021/11/26 09:34

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -6,14 +6,148 @@
6
6
 
7
7
 
8
8
 
9
+ Dim sPath As String, fn As String
10
+
11
+ Dim wb As Workbook, ws As Worksheet
12
+
13
+ Dim rng1 As Range, rng2 As Range
14
+
15
+
16
+
17
+ sPath = "C:\Users\XXXXXXX\Desktop\XXXXXXX.xlsx"
18
+
19
+ fn = "XXXXXXX.xlsx"
20
+
21
+ For Each wb In Workbooks
22
+
23
+ If wb.Name = fn Then Exit For
24
+
25
+ Next wb
26
+
27
+ If wb Is Nothing Then
28
+
29
+ Set wb = Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
30
+
31
+ End If
32
+
33
+ Set ws = wb.Worksheets("sheet1")
34
+
35
+ Set rng1 = ws.Range("I1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
36
+
37
+ Set rng2 = ws.Range("AM1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
38
+
39
+
40
+
41
+ Debug.Print "納品予定日の参照先:", wb.Name, ws.Name, rng2.Address
42
+
43
+
44
+
45
+ Dim res As Worksheet
46
+
47
+ Dim z As Long
48
+
49
+
50
+
51
+ Set res = Worksheets("result")
52
+
53
+ z = res.UsedRange.Rows.Count
54
+
55
+ Debug.Print "結果シート:"; res.Name, "最終行:", z
56
+
57
+
58
+
59
+ Dim i As Long
60
+
61
+ Dim x As String
62
+
63
+ Dim wsf As WorksheetFunction
64
+
65
+ Set wsf = WorksheetFunction
66
+
67
+
68
+
69
+ For i = 2 To z
70
+
71
+ '発注番号を取得
72
+
73
+ x = res.Cells(i, 3).Value
74
+
75
+ '納品予定日の値を表示
76
+
77
+ res.Cells(i, 7).Value = wsf.Index(rng1, wsf.Match(x, rng2.Value, 0), 1)
78
+
79
+ res.Cells(i, 7).NumberFormat = "yyyy/mm/dd"
80
+
81
+
82
+
83
+ If res.Cells(i, 7).Value = "" Then
84
+
85
+ res.Cells(i, 6).Value = "3"
86
+
87
+ Else
88
+
89
+ res.Cells(i, 6).Value = "1"
90
+
91
+ End If
92
+
93
+
94
+
95
+ Debug.Print "行番号", i, "発注番号", x, "F列", res.Cells(i, 6).Value, "G列(納品予定日)", res.Cells(i, 7).Value
96
+
97
+ Next
98
+
99
+
100
+
101
+ wb.Close False
102
+
103
+ End Sub
104
+
105
+
106
+
107
+ ```
108
+
109
+
110
+
111
+ ＜修正前＞
112
+
113
+ 起きている事象がよくつかめませんが、エラーが起きるわけではないんですね？
114
+
115
+ 以下のようにデバッグ文を入れて、イミディエイトウィンドウにどう出るか確認してみては？
116
+
117
+
118
+
119
+ ```VBA
120
+
121
+ Option Explicit
122
+
123
+
124
+
125
+ Sub 検索()
126
+
127
+
128
+
129
+ Dim res As Worksheet
130
+
131
+ Dim z As Long
132
+
133
+ Set res = Worksheets("result")
134
+
135
+ z = res.Cells(res.Rows.Count, "G").End(xlUp).Row
136
+
137
+
138
+
139
+ Debug.Print res.Name, z
140
+
141
+
142
+
9
143
  Dim sPath As String
10
144
 
145
+ Dim wb As Workbook
146
+
11
- Dim wb As Workbook, ws As Worksheet
147
+ Dim ws As Worksheet
12
148
 
13
149
  Dim rng1 As Range, rng2 As Range
14
150
 
15
-
16
-
17
151
  sPath = "C:\Users\XXXXXXX\Desktop\XXXXXXX.xlsx"
18
152
 
19
153
  Set wb = Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
@@ -24,23 +158,9 @@
24
158
 
25
159
  Set rng2 = ws.Range("AM1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
26
160
 
27
-
28
-
161
+
162
+
29
- Debug.Print "納品予定日の参照先:", wb.Name, ws.Name, rng2.Address
163
+ Debug.Print wb.Name, ws.Name, rng1.Address, rng2.Address
30
-
31
-
32
-
33
- Dim res As Worksheet
34
-
35
- Dim z As Long
36
-
37
-
38
-
39
- Set res = Worksheets("result")
40
-
41
- z = res.UsedRange.Rows.Count
42
-
43
- Debug.Print "結果シート:"; res.Name, "最終行:", z
44
164
 
45
165
 
46
166
 
@@ -48,216 +168,108 @@
48
168
 
49
169
  Dim x As String
50
170
 
51
- Dim wsf As WorksheetFunction
52
-
53
- Set wsf = WorksheetFunction
54
-
55
-
56
-
57
171
  For i = 2 To z
58
172
 
59
173
  '発注番号を取得
60
174
 
61
175
  x = res.Cells(i, 3).Value
62
176
 
63
- '納品予定日の値を表示
177
+ '納品予定日の値を表示
178
+
64
-
179
+ With Application.WorksheetFunction
180
+
65
- res.Cells(i, 7).Value = wsf.Index(rng1, wsf.Match(x, rng2.Value, 0), 1)
181
+ res.Cells(i, 7).Value = .Index(rng1, .Match(x, rng2.Value, 0), 1)
182
+
66
-
183
+ End With
184
+
185
+
186
+
187
+ Debug.Print i, x, ws.Name, res.Cells(i, 7).Value
188
+
189
+
190
+
191
+ Next
192
+
193
+
194
+
195
+ Dim y As Long
196
+
67
- res.Cells(i, 7).NumberFormat = "yyyy/mm/dd"
197
+ y = res.Cells(res.Rows.Count, "F").End(xlUp).Row
198
+
199
+
200
+
68
-
201
+ Debug.Print y
202
+
203
+
204
+
69
-
205
+ Dim j As Long
206
+
70
-
207
+ For j = 2 To y
208
+
71
- If res.Cells(i, 7).Value = "" Then
209
+ If res.Cells(j, 7).Value = "" Then
72
-
210
+
73
- res.Cells(i, 6).Value = "3"
211
+ res.Cells(j, 6).Value = "3"
74
212
 
75
213
  Else
76
214
 
77
- res.Cells(i, 6).Value = "1"
215
+ res.Cells(j, 6).Value = "1"
78
216
 
79
217
  End If
80
218
 
81
-
82
-
219
+
220
+
83
- Debug.Print "行番号", i, "発注番号", x, "F列", res.Cells(i, 6).Value, "G列(納品予定日)", res.Cells(i, 7).Value
221
+ Debug.Print j, res.Cells(j, 6).Value
222
+
223
+
84
224
 
85
225
  Next
86
226
 
87
227
 
88
228
 
89
- wb.Close False
229
+ Dim myDate As Date
230
+
231
+ Dim v As Long
232
+
233
+ With res
234
+
235
+ v = .Cells(.Rows.Count, "G").End(xlUp).Row
236
+
237
+
238
+
239
+ Debug.Print v
240
+
241
+
242
+
243
+ For j = 2 To v
244
+
245
+ Dim strDate As String
246
+
247
+ strDate = Format(.Cells(j, 7).Value, " ####/##/##")
248
+
249
+ If IsDate(strDate) Then
250
+
251
+ .Cells(j, 7).NumberFormat = "yyyy/mm/dd"
252
+
253
+ .Cells(j, 7).Value = CDate(strDate)
254
+
255
+ End If
256
+
257
+
258
+
259
+ Debug.Print j, strDate
260
+
261
+
262
+
263
+ Next
264
+
265
+ End With
266
+
267
+
268
+
269
+
90
270
 
91
271
  End Sub
92
272
 
93
273
 
94
274
 
95
275
  ```
96
-
97
-
98
-
99
- ＜修正前＞
100
-
101
- 起きている事象がよくつかめませんが、エラーが起きるわけではないんですね？
102
-
103
- 以下のようにデバッグ文を入れて、イミディエイトウィンドウにどう出るか確認してみては？
104
-
105
-
106
-
107
- ```VBA
108
-
109
- Option Explicit
110
-
111
-
112
-
113
- Sub 検索()
114
-
115
-
116
-
117
- Dim res As Worksheet
118
-
119
- Dim z As Long
120
-
121
- Set res = Worksheets("result")
122
-
123
- z = res.Cells(res.Rows.Count, "G").End(xlUp).Row
124
-
125
-
126
-
127
- Debug.Print res.Name, z
128
-
129
-
130
-
131
- Dim sPath As String
132
-
133
- Dim wb As Workbook
134
-
135
- Dim ws As Worksheet
136
-
137
- Dim rng1 As Range, rng2 As Range
138
-
139
- sPath = "C:\Users\XXXXXXX\Desktop\XXXXXXX.xlsx"
140
-
141
- Set wb = Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
142
-
143
- Set ws = wb.Worksheets("sheet1")
144
-
145
- Set rng1 = ws.Range("I1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
146
-
147
- Set rng2 = ws.Range("AM1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
148
-
149
-
150
-
151
- Debug.Print wb.Name, ws.Name, rng1.Address, rng2.Address
152
-
153
-
154
-
155
- Dim i As Long
156
-
157
- Dim x As String
158
-
159
- For i = 2 To z
160
-
161
- '発注番号を取得
162
-
163
- x = res.Cells(i, 3).Value
164
-
165
- '納品予定日の値を表示
166
-
167
- With Application.WorksheetFunction
168
-
169
- res.Cells(i, 7).Value = .Index(rng1, .Match(x, rng2.Value, 0), 1)
170
-
171
- End With
172
-
173
-
174
-
175
- Debug.Print i, x, ws.Name, res.Cells(i, 7).Value
176
-
177
-
178
-
179
- Next
180
-
181
-
182
-
183
- Dim y As Long
184
-
185
- y = res.Cells(res.Rows.Count, "F").End(xlUp).Row
186
-
187
-
188
-
189
- Debug.Print y
190
-
191
-
192
-
193
- Dim j As Long
194
-
195
- For j = 2 To y
196
-
197
- If res.Cells(j, 7).Value = "" Then
198
-
199
- res.Cells(j, 6).Value = "3"
200
-
201
- Else
202
-
203
- res.Cells(j, 6).Value = "1"
204
-
205
- End If
206
-
207
-
208
-
209
- Debug.Print j, res.Cells(j, 6).Value
210
-
211
-
212
-
213
- Next
214
-
215
-
216
-
217
- Dim myDate As Date
218
-
219
- Dim v As Long
220
-
221
- With res
222
-
223
- v = .Cells(.Rows.Count, "G").End(xlUp).Row
224
-
225
-
226
-
227
- Debug.Print v
228
-
229
-
230
-
231
- For j = 2 To v
232
-
233
- Dim strDate As String
234
-
235
- strDate = Format(.Cells(j, 7).Value, " ####/##/##")
236
-
237
- If IsDate(strDate) Then
238
-
239
- .Cells(j, 7).NumberFormat = "yyyy/mm/dd"
240
-
241
- .Cells(j, 7).Value = CDate(strDate)
242
-
243
- End If
244
-
245
-
246
-
247
- Debug.Print j, strDate
248
-
249
-
250
-
251
- Next
252
-
253
- End With
254
-
255
-
256
-
257
-
258
-
259
- End Sub
260
-
261
-
262
-
263
- ```

3

修正

2021/11/26 09:34

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -1,4 +1,102 @@
1
+ ＜修正＞　こんな感じでどうでしょうか。
2
+
3
+ ```VBA
4
+
5
+ Sub 検索()
6
+
7
+
8
+
9
+ Dim sPath As String
10
+
11
+ Dim wb As Workbook, ws As Worksheet
12
+
13
+ Dim rng1 As Range, rng2 As Range
14
+
15
+
16
+
17
+ sPath = "C:\Users\XXXXXXX\Desktop\XXXXXXX.xlsx"
18
+
19
+ Set wb = Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
20
+
21
+ Set ws = wb.Worksheets("sheet1")
22
+
23
+ Set rng1 = ws.Range("I1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
24
+
25
+ Set rng2 = ws.Range("AM1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
26
+
27
+
28
+
29
+ Debug.Print "納品予定日の参照先:", wb.Name, ws.Name, rng2.Address
30
+
31
+
32
+
33
+ Dim res As Worksheet
34
+
35
+ Dim z As Long
36
+
37
+
38
+
39
+ Set res = Worksheets("result")
40
+
41
+ z = res.UsedRange.Rows.Count
42
+
43
+ Debug.Print "結果シート:"; res.Name, "最終行:", z
44
+
45
+
46
+
47
+ Dim i As Long
48
+
49
+ Dim x As String
50
+
51
+ Dim wsf As WorksheetFunction
52
+
53
+ Set wsf = WorksheetFunction
54
+
55
+
56
+
57
+ For i = 2 To z
58
+
59
+ '発注番号を取得
60
+
61
+ x = res.Cells(i, 3).Value
62
+
63
+ '納品予定日の値を表示
64
+
65
+ res.Cells(i, 7).Value = wsf.Index(rng1, wsf.Match(x, rng2.Value, 0), 1)
66
+
67
+ res.Cells(i, 7).NumberFormat = "yyyy/mm/dd"
68
+
69
+
70
+
71
+ If res.Cells(i, 7).Value = "" Then
72
+
73
+ res.Cells(i, 6).Value = "3"
74
+
75
+ Else
76
+
77
+ res.Cells(i, 6).Value = "1"
78
+
79
+ End If
80
+
81
+
82
+
83
+ Debug.Print "行番号", i, "発注番号", x, "F列", res.Cells(i, 6).Value, "G列(納品予定日)", res.Cells(i, 7).Value
84
+
85
+ Next
86
+
87
+
88
+
89
+ wb.Close False
90
+
91
+ End Sub
92
+
93
+
94
+
95
+ ```
96
+
97
+
98
+
1
- ＜追記＞
99
+ ＜修正前＞
2
100
 
3
101
  起きている事象がよくつかめませんが、エラーが起きるわけではないんですね？
4
102
 
@@ -163,157 +261,3 @@
163
261
 
164
262
 
165
263
  ```
166
-
167
-
168
-
169
- ---
170
-
171
- ＜追記前＞
172
-
173
- 全部は見切れてないですけど、とりあえず`Cells(Rows.Count, "AM").End(xlUp).Row`のところを直したらよいかも。
174
-
175
- ```VBA
176
-
177
- Set wb = ex.Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
178
-
179
- Dim ws As Worksheet
180
-
181
- Set ws = wb.Worksheets("sheet1")
182
-
183
- With ActiveSheet
184
-
185
- '納品予定日の値を表示
186
-
187
- On Error Resume Next
188
-
189
- .Cells(i, 7).Value = _
190
-
191
- Application.WorksheetFunction.Index(ws.Range("I1:AM" & ws.Cells(Rows.Count, "AM").End(xlUp).Row), Application.WorksheetFunction.Match(x, ws.Range("AM1:AM" & ws.Cells(Rows.Count, "AM").End(xlUp).Row).Value, 0), 1)
192
-
193
- End With
194
-
195
-
196
-
197
- ```
198
-
199
-
200
-
201
-
202
-
203
-
204
-
205
- ```VBA
206
-
207
- Option Explicit
208
-
209
-
210
-
211
- Sub 検索()
212
-
213
-
214
-
215
- Dim res As Worksheet
216
-
217
- Dim z As Long
218
-
219
- Set res = Worksheets("result")
220
-
221
- z = res.Cells(res.Rows.Count, "G").End(xlUp).Row
222
-
223
-
224
-
225
- Dim sPath As String
226
-
227
- Dim wb As Workbook
228
-
229
- Dim ws As Worksheet
230
-
231
- Dim rng1 As Range, rng2 As Range
232
-
233
- sPath = "C:\Users\XXXXXXX\Desktop\XXXXXXX.xlsx"
234
-
235
- Set wb = Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
236
-
237
- Set ws = wb.Worksheets("sheet1")
238
-
239
- Set rng1 = ws.Range("I1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
240
-
241
- Set rng2 = ws.Range("AM1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
242
-
243
-
244
-
245
- Dim i As Long
246
-
247
- Dim x As String
248
-
249
- For i = 2 To z
250
-
251
- '発注番号を取得
252
-
253
- x = res.Cells(i, 3).Value
254
-
255
- '納品予定日の値を表示
256
-
257
- With Application.WorksheetFunction
258
-
259
- res.Cells(i, 7).Value = .Index(rng1, .Match(x, rng2.Value, 0), 1)
260
-
261
- End With
262
-
263
- Next
264
-
265
-
266
-
267
- Dim y As Long
268
-
269
- y = res.Cells(res.Rows.Count, "F").End(xlUp).Row
270
-
271
-
272
-
273
- Dim j As Long
274
-
275
- For j = 2 To y
276
-
277
- If res.Cells(j, 7).Value = "" Then
278
-
279
- res.Cells(j, 6).Value = "3"
280
-
281
- Else
282
-
283
- res.Cells(j, 6).Value = "1"
284
-
285
- End If
286
-
287
- Next
288
-
289
-
290
-
291
- Dim myDate As Date
292
-
293
- Dim v As Long
294
-
295
- With res
296
-
297
- v = .Cells(.Rows.Count, "G").End(xlUp).Row
298
-
299
- For j = 2 To v
300
-
301
- Dim strDate As String
302
-
303
- strDate = Format(.Cells(j, 7).Value, " ####/##/##")
304
-
305
- If IsDate(strDate) Then
306
-
307
- .Cells(j, 7).NumberFormat = "yyyy/mm/dd"
308
-
309
- .Cells(j, 7).Value = CDate(strDate)
310
-
311
- End If
312
-
313
- Next
314
-
315
- End With
316
-
317
- End Sub
318
-
319
- ```

2

追記

2021/11/26 08:30

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -1,3 +1,175 @@
1
+ ＜追記＞
2
+
3
+ 起きている事象がよくつかめませんが、エラーが起きるわけではないんですね？
4
+
5
+ 以下のようにデバッグ文を入れて、イミディエイトウィンドウにどう出るか確認してみては？
6
+
7
+
8
+
9
+ ```VBA
10
+
11
+ Option Explicit
12
+
13
+
14
+
15
+ Sub 検索()
16
+
17
+
18
+
19
+ Dim res As Worksheet
20
+
21
+ Dim z As Long
22
+
23
+ Set res = Worksheets("result")
24
+
25
+ z = res.Cells(res.Rows.Count, "G").End(xlUp).Row
26
+
27
+
28
+
29
+ Debug.Print res.Name, z
30
+
31
+
32
+
33
+ Dim sPath As String
34
+
35
+ Dim wb As Workbook
36
+
37
+ Dim ws As Worksheet
38
+
39
+ Dim rng1 As Range, rng2 As Range
40
+
41
+ sPath = "C:\Users\XXXXXXX\Desktop\XXXXXXX.xlsx"
42
+
43
+ Set wb = Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
44
+
45
+ Set ws = wb.Worksheets("sheet1")
46
+
47
+ Set rng1 = ws.Range("I1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
48
+
49
+ Set rng2 = ws.Range("AM1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
50
+
51
+
52
+
53
+ Debug.Print wb.Name, ws.Name, rng1.Address, rng2.Address
54
+
55
+
56
+
57
+ Dim i As Long
58
+
59
+ Dim x As String
60
+
61
+ For i = 2 To z
62
+
63
+ '発注番号を取得
64
+
65
+ x = res.Cells(i, 3).Value
66
+
67
+ '納品予定日の値を表示
68
+
69
+ With Application.WorksheetFunction
70
+
71
+ res.Cells(i, 7).Value = .Index(rng1, .Match(x, rng2.Value, 0), 1)
72
+
73
+ End With
74
+
75
+
76
+
77
+ Debug.Print i, x, ws.Name, res.Cells(i, 7).Value
78
+
79
+
80
+
81
+ Next
82
+
83
+
84
+
85
+ Dim y As Long
86
+
87
+ y = res.Cells(res.Rows.Count, "F").End(xlUp).Row
88
+
89
+
90
+
91
+ Debug.Print y
92
+
93
+
94
+
95
+ Dim j As Long
96
+
97
+ For j = 2 To y
98
+
99
+ If res.Cells(j, 7).Value = "" Then
100
+
101
+ res.Cells(j, 6).Value = "3"
102
+
103
+ Else
104
+
105
+ res.Cells(j, 6).Value = "1"
106
+
107
+ End If
108
+
109
+
110
+
111
+ Debug.Print j, res.Cells(j, 6).Value
112
+
113
+
114
+
115
+ Next
116
+
117
+
118
+
119
+ Dim myDate As Date
120
+
121
+ Dim v As Long
122
+
123
+ With res
124
+
125
+ v = .Cells(.Rows.Count, "G").End(xlUp).Row
126
+
127
+
128
+
129
+ Debug.Print v
130
+
131
+
132
+
133
+ For j = 2 To v
134
+
135
+ Dim strDate As String
136
+
137
+ strDate = Format(.Cells(j, 7).Value, " ####/##/##")
138
+
139
+ If IsDate(strDate) Then
140
+
141
+ .Cells(j, 7).NumberFormat = "yyyy/mm/dd"
142
+
143
+ .Cells(j, 7).Value = CDate(strDate)
144
+
145
+ End If
146
+
147
+
148
+
149
+ Debug.Print j, strDate
150
+
151
+
152
+
153
+ Next
154
+
155
+ End With
156
+
157
+
158
+
159
+
160
+
161
+ End Sub
162
+
163
+
164
+
165
+ ```
166
+
167
+
168
+
169
+ ---
170
+
171
+ ＜追記前＞
172
+
1
173
  全部は見切れてないですけど、とりあえず`Cells(Rows.Count, "AM").End(xlUp).Row`のところを直したらよいかも。
2
174
 
3
175
  ```VBA
@@ -26,9 +198,7 @@
26
198
 
27
199
 
28
200
 
29
- ---
201
+
30
-
31
- ＜追記＞
32
202
 
33
203
 
34
204
 

1

追記

2021/11/19 08:20

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -23,3 +23,127 @@
23
23
 
24
24
 
25
25
  ```
26
+
27
+
28
+
29
+ ---
30
+
31
+ ＜追記＞
32
+
33
+
34
+
35
+ ```VBA
36
+
37
+ Option Explicit
38
+
39
+
40
+
41
+ Sub 検索()
42
+
43
+
44
+
45
+ Dim res As Worksheet
46
+
47
+ Dim z As Long
48
+
49
+ Set res = Worksheets("result")
50
+
51
+ z = res.Cells(res.Rows.Count, "G").End(xlUp).Row
52
+
53
+
54
+
55
+ Dim sPath As String
56
+
57
+ Dim wb As Workbook
58
+
59
+ Dim ws As Worksheet
60
+
61
+ Dim rng1 As Range, rng2 As Range
62
+
63
+ sPath = "C:\Users\XXXXXXX\Desktop\XXXXXXX.xlsx"
64
+
65
+ Set wb = Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
66
+
67
+ Set ws = wb.Worksheets("sheet1")
68
+
69
+ Set rng1 = ws.Range("I1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
70
+
71
+ Set rng2 = ws.Range("AM1:AM" & ws.Cells(ws.Rows.Count, "AM").End(xlUp).Row)
72
+
73
+
74
+
75
+ Dim i As Long
76
+
77
+ Dim x As String
78
+
79
+ For i = 2 To z
80
+
81
+ '発注番号を取得
82
+
83
+ x = res.Cells(i, 3).Value
84
+
85
+ '納品予定日の値を表示
86
+
87
+ With Application.WorksheetFunction
88
+
89
+ res.Cells(i, 7).Value = .Index(rng1, .Match(x, rng2.Value, 0), 1)
90
+
91
+ End With
92
+
93
+ Next
94
+
95
+
96
+
97
+ Dim y As Long
98
+
99
+ y = res.Cells(res.Rows.Count, "F").End(xlUp).Row
100
+
101
+
102
+
103
+ Dim j As Long
104
+
105
+ For j = 2 To y
106
+
107
+ If res.Cells(j, 7).Value = "" Then
108
+
109
+ res.Cells(j, 6).Value = "3"
110
+
111
+ Else
112
+
113
+ res.Cells(j, 6).Value = "1"
114
+
115
+ End If
116
+
117
+ Next
118
+
119
+
120
+
121
+ Dim myDate As Date
122
+
123
+ Dim v As Long
124
+
125
+ With res
126
+
127
+ v = .Cells(.Rows.Count, "G").End(xlUp).Row
128
+
129
+ For j = 2 To v
130
+
131
+ Dim strDate As String
132
+
133
+ strDate = Format(.Cells(j, 7).Value, " ####/##/##")
134
+
135
+ If IsDate(strDate) Then
136
+
137
+ .Cells(j, 7).NumberFormat = "yyyy/mm/dd"
138
+
139
+ .Cells(j, 7).Value = CDate(strDate)
140
+
141
+ End If
142
+
143
+ Next
144
+
145
+ End With
146
+
147
+ End Sub
148
+
149
+ ```