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

質問編集履歴

2

コードを追記しました。

2018/12/24 18:14

投稿

manabumono
manabumono

スコア12

title CHANGED
File without changes
body CHANGED
@@ -14,4 +14,119 @@
14
14
    読み込み等に時間がかかってエラーになるのでしょうか?
15
15
  ④配列の出力関数(配列の値をシートに戻す)
16
16
 
17
- 宜しくお願い致します。
17
+ 宜しくお願い致します。
18
+
19
+ ```ここに言語を入力
20
+ '*******************************************************
21
+ 'メイン
22
+ '*******************************************************
23
+ Public Sub main()
24
+ Dim window1 As Window
25
+ Dim anser As Long
26
+ Dim arry() As Variant
27
+ Dim rStart As Long
28
+ Dim rLast As Long
29
+
30
+ '処理実行
31
+ If MakeArry(arry(), rStart, rLast) = 0 Then '配列作成
32
+ '配列作成成功
33
+ Call Keyword_check(arry(), rStart, rLast) 'キーワードチェック
34
+ Call out_arry(arry(), rStart, rLast) '配列出力
35
+ End If
36
+
37
+ End Sub
38
+
39
+ '*******************************************************
40
+ '配列作成
41
+ '*******************************************************
42
+ Private Function MakeArry(ByRef arry As Variant, ByRef rStart As Long, ByRef rLast As Long) As Integer
43
+
44
+ '配列の必要最小範囲を調べる
45
+ Range("G5").Select '先頭行を選択
46
+ If ActiveCell.Value <> Empty Then
47
+ '1行目が空でなければスタートを1行目にする
48
+ rStart = ActiveCell.Row '配列の最初行
49
+ Else
50
+ Selection.End(xlDown).Select '最初にぶつかる行へ移動
51
+ If ActiveCell.Value <> Empty Then
52
+ rStart = ActiveCell.Row '配列の最初行
53
+ Else
54
+ MsgBox "対象データがありません"
55
+ MakeArry = -1
56
+ Exit Function
57
+ End If
58
+ End If
59
+ Range("G65536").Select '最終行を選択
60
+ If ActiveCell.Value <> Empty Then
61
+ '65536行目が空でなければスタートを65536行目にする
62
+ rLast = ActiveCell.Row '配列の最終行
63
+ Else
64
+ Selection.End(xlUp).Select '最初にぶつかる行へ移動
65
+ If ActiveCell.Value <> Empty Then
66
+ rLast = ActiveCell.Row '配列の最終行
67
+ Else
68
+ Selection.End(xlUp).Select '最初にぶつかる行へ移動
69
+ If ActiveCell.Value <> Empty Then
70
+ rLast = ActiveCell.Row '配列の最終行
71
+ Else
72
+ MsgBox "対象データがありません"
73
+ MakeArry = -1
74
+ Exit Function
75
+ End If
76
+ End If
77
+ End If
78
+
79
+ 'C~J列取込み
80
+ arry = Range("C" & rStart & ":J" & rLast)
81
+
82
+ MakeArry = 0
83
+ Exit Function
84
+
85
+ End Function
86
+
87
+ '*******************************************************
88
+ 'チェック&編集
89
+ '*******************************************************
90
+ Private Sub Keyword_check(ByRef arry As Variant, ByRef rStart As Long, ByRef rLast As Long)
91
+
92
+ Dim i As Long
93
+
94
+
95
+ For i = LBound(arry) To UBound(arry)
96
+
97
+ If arry(i, 5) <> Empty Then
98
+
99
+ '難易度判定
100
+ If 0 <= arry(i, 6) And arry(i, 6) <= 32 Then
101
+ '0~32の場合
102
+ arry(i, 1) = "OK1"
103
+ arry(i, 2) = arry(i, 5)
104
+ arry(i, 5) = Empty
105
+ ElseIf 33 <= arry(i, 6) And arry(i, 6) <= 50 Then
106
+ '33~50の場合
107
+ arry(i, 1) = "OK2"
108
+ arry(i, 2) = arry(i, 5)
109
+ arry(i, 5) = Empty
110
+ Else
111
+ 'その他の場合
112
+ arry(i, 1) = "NG"
113
+ arry(i, 2) = arry(i, 5)
114
+ arry(i, 5) = Empty
115
+ End If
116
+ End If
117
+
118
+ Next i
119
+
120
+ End Sub
121
+
122
+ '*******************************************************
123
+ '配列出力
124
+ '*******************************************************
125
+ Private Sub out_arry(ByRef arry() As Variant, ByRef rStart As Long, ByRef rLast As Long)
126
+ 'C~J列に戻す
127
+ Range("C" & rStart & ":J" & rLast) = arry '値がある最初行~値がある最終行まで
128
+
129
+ End Sub
130
+
131
+
132
+ ```

1

補足追加

2018/12/24 18:14

投稿

manabumono
manabumono

スコア12

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