質問編集履歴

2

コードを追記しました。

2018/12/24 18:14

投稿

manabumono
manabumono

スコア12

test CHANGED
File without changes
test CHANGED
@@ -31,3 +31,233 @@
31
31
 
32
32
 
33
33
  宜しくお願い致します。
34
+
35
+
36
+
37
+ ```ここに言語を入力
38
+
39
+ '*******************************************************
40
+
41
+ 'メイン
42
+
43
+ '*******************************************************
44
+
45
+ Public Sub main()
46
+
47
+ Dim window1 As Window
48
+
49
+ Dim anser As Long
50
+
51
+ Dim arry() As Variant
52
+
53
+ Dim rStart As Long
54
+
55
+ Dim rLast As Long
56
+
57
+
58
+
59
+ '処理実行
60
+
61
+ If MakeArry(arry(), rStart, rLast) = 0 Then '配列作成
62
+
63
+ '配列作成成功
64
+
65
+ Call Keyword_check(arry(), rStart, rLast) 'キーワードチェック
66
+
67
+ Call out_arry(arry(), rStart, rLast) '配列出力
68
+
69
+ End If
70
+
71
+
72
+
73
+ End Sub
74
+
75
+
76
+
77
+ '*******************************************************
78
+
79
+ '配列作成
80
+
81
+ '*******************************************************
82
+
83
+ Private Function MakeArry(ByRef arry As Variant, ByRef rStart As Long, ByRef rLast As Long) As Integer
84
+
85
+
86
+
87
+ '配列の必要最小範囲を調べる
88
+
89
+ Range("G5").Select '先頭行を選択
90
+
91
+ If ActiveCell.Value <> Empty Then
92
+
93
+ '1行目が空でなければスタートを1行目にする
94
+
95
+ rStart = ActiveCell.Row '配列の最初行
96
+
97
+ Else
98
+
99
+ Selection.End(xlDown).Select '最初にぶつかる行へ移動
100
+
101
+ If ActiveCell.Value <> Empty Then
102
+
103
+ rStart = ActiveCell.Row '配列の最初行
104
+
105
+ Else
106
+
107
+ MsgBox "対象データがありません"
108
+
109
+ MakeArry = -1
110
+
111
+ Exit Function
112
+
113
+ End If
114
+
115
+ End If
116
+
117
+ Range("G65536").Select '最終行を選択
118
+
119
+ If ActiveCell.Value <> Empty Then
120
+
121
+ '65536行目が空でなければスタートを65536行目にする
122
+
123
+ rLast = ActiveCell.Row '配列の最終行
124
+
125
+ Else
126
+
127
+ Selection.End(xlUp).Select '最初にぶつかる行へ移動
128
+
129
+ If ActiveCell.Value <> Empty Then
130
+
131
+ rLast = ActiveCell.Row '配列の最終行
132
+
133
+ Else
134
+
135
+ Selection.End(xlUp).Select '最初にぶつかる行へ移動
136
+
137
+ If ActiveCell.Value <> Empty Then
138
+
139
+ rLast = ActiveCell.Row '配列の最終行
140
+
141
+ Else
142
+
143
+ MsgBox "対象データがありません"
144
+
145
+ MakeArry = -1
146
+
147
+ Exit Function
148
+
149
+ End If
150
+
151
+ End If
152
+
153
+ End If
154
+
155
+
156
+
157
+ 'C~J列取込み
158
+
159
+ arry = Range("C" & rStart & ":J" & rLast)
160
+
161
+
162
+
163
+ MakeArry = 0
164
+
165
+ Exit Function
166
+
167
+
168
+
169
+ End Function
170
+
171
+
172
+
173
+ '*******************************************************
174
+
175
+ 'チェック&編集
176
+
177
+ '*******************************************************
178
+
179
+ Private Sub Keyword_check(ByRef arry As Variant, ByRef rStart As Long, ByRef rLast As Long)
180
+
181
+
182
+
183
+ Dim i As Long
184
+
185
+
186
+
187
+
188
+
189
+ For i = LBound(arry) To UBound(arry)
190
+
191
+
192
+
193
+ If arry(i, 5) <> Empty Then
194
+
195
+
196
+
197
+ '難易度判定
198
+
199
+ If 0 <= arry(i, 6) And arry(i, 6) <= 32 Then
200
+
201
+ '0~32の場合
202
+
203
+ arry(i, 1) = "OK1"
204
+
205
+ arry(i, 2) = arry(i, 5)
206
+
207
+ arry(i, 5) = Empty
208
+
209
+ ElseIf 33 <= arry(i, 6) And arry(i, 6) <= 50 Then
210
+
211
+ '33~50の場合
212
+
213
+ arry(i, 1) = "OK2"
214
+
215
+ arry(i, 2) = arry(i, 5)
216
+
217
+ arry(i, 5) = Empty
218
+
219
+ Else
220
+
221
+ 'その他の場合
222
+
223
+ arry(i, 1) = "NG"
224
+
225
+ arry(i, 2) = arry(i, 5)
226
+
227
+ arry(i, 5) = Empty
228
+
229
+ End If
230
+
231
+ End If
232
+
233
+
234
+
235
+ Next i
236
+
237
+
238
+
239
+ End Sub
240
+
241
+
242
+
243
+ '*******************************************************
244
+
245
+ '配列出力
246
+
247
+ '*******************************************************
248
+
249
+ Private Sub out_arry(ByRef arry() As Variant, ByRef rStart As Long, ByRef rLast As Long)
250
+
251
+ 'C~J列に戻す
252
+
253
+ Range("C" & rStart & ":J" & rLast) = arry '値がある最初行~値がある最終行まで
254
+
255
+
256
+
257
+ End Sub
258
+
259
+
260
+
261
+
262
+
263
+ ```

1

補足追加

2018/12/24 18:14

投稿

manabumono
manabumono

スコア12

test CHANGED
File without changes
test CHANGED
@@ -1,3 +1,9 @@
1
+ お世話になっております。
2
+
3
+
4
+
5
+ 【現象】
6
+
1
7
  エクセルで配列の加工をするプログラムを作成していますが、
2
8
 
3
9
  ステップ実行をすれば最後までエラーがなく終了するのに
@@ -6,13 +12,19 @@
6
12
 
7
13
 
8
14
 
15
+ 【内容】
16
+
9
17
  配列処理の大まかな流れは以下の通りです。
10
18
 
11
19
  ①メイン関数(②~④を呼び出す)
12
20
 
13
21
  ②配列取得関数(シートから配列を取得)
14
22
 
15
- ③配列のチェック&加工関数
23
+ ③配列のチェック&加工関数(行ごとにループを回してます。)
24
+
25
+  ※ここでエラー発生、関数間で配列の参照渡しがうまくいっていないか、
26
+
27
+   読み込み等に時間がかかってエラーになるのでしょうか?
16
28
 
17
29
  ④配列の出力関数(配列の値をシートに戻す)
18
30