| |
どうしても配列のところでエラーがでてしまい
うまくいかなくて困ってます
エラー内容は
インデックスが有効範囲にありません
というものなのですが、
マクロの流れとしましては、
Loopしている中で、配列を使用しています
その為、データ数分Loopするのですが、
処理がループ内で回る毎に、動的配列を初期化させて、新たな値を動的配列に格納していこうとしています･･･が、途中でエラーになってしまいます
現在は、エラー回避で、エラーになったら飛ばそうとして設定してみたところ、
一回はエラー回避で飛ばせるものの、2回以降、エラーが発生すると、
エラー回避をしてくれません
どうしたら、うまくいくのでしょうか？
できれば、エラー回避での解決ではなく、
その動的配列が初期化されていたら、処理をする
初期化されていない場合は、処理をしない
といった形が理想なのです
どうかよろしくおねがいします
現在のコードは下記の通りです
Dim MyLN As Long
Dim MaxR As Long, 記録R As Long
Dim STAGE As Object
Dim MyKey
Dim MyString
Dim MySTAGE
Dim strFile As String
Dim MyFile As String
Dim MyVal, MyVal2
Dim lCnt As Long
Dim MyData()
'使用原紙の保管場所
strFile = "記録表"
MyFile = "C:\Temp\" & strFile & ".xls"
Set STAGE = CreateObject("scripting.dictionary")
MyLN = 50
With Sheets(1)
MaxR = .Range("Y" & Rows.Count).End(xlUp).Row
For i = 3 To MaxR
If Not .Cells(i, "Y").Value = Empty Then
If Not STAGE.exists(.Cells(i, "Y").Value) Then
STAGE.Add .Cells(i, "Y").Value, ""
End If
End If
Next i
End With
'記録表ファイルを開く
If Dir(MyFile) <> "" Then
Workbooks.Open MyFile
MyKey = STAGE.keys
For i = 0 To UBound(MyKey)
MySTAGE = MyKey(i)
Call シート挿入(MySTAGE)
z = 0
With ThisWorkbook.Sheets(1)
For q = 3 To MaxR
If .Cells(q, "Y").Value = MySTAGE Then
If .Cells(q, "I").Value <> "" And .Cells(q, "J").Value <> "" Then
If .Cells(q, "I").Value <= MyLN And .Cells(q, "J").Value >= MyLN Then
MyVal = Array(.Cells(q, "N").Value)
For x = 15 To 24
lCnt = UBound(MyVal) + 1
ReDim Preserve MyVal(lCnt)
MyVal(lCnt) = .Cells(q, x).Value
Next x
ReDim Preserve MyData(z)
MyData(z) = MyVal
z = z + 1
End If
End If
End If
Next q
End With
On Error GoTo MyErr
'↓ココでエラー発生（MyDataに値がないとき）
For e = 0 To UBound(MyData）
記録R = Range("C" & Rows.Count).End(xlUp).Row + 1
Cells(記録R, "C").Value = (MyData(e)(0))
Cells(記録R, "G").Value = (MyData(e)(1))
Cells(記録R, "K").Value = (MyData(e)(2))
Cells(記録R, "N").Value = (MyData(e)(3))
Cells(記録R, "Q").Value = (MyData(e)(4))
Cells(記録R, "U").Value = (MyData(e)(5))
Cells(記録R, "V").Value = (MyData(e)(6))
Cells(記録R, "Y").Value = (MyData(e)(7))
Cells(記録R, "AB").Value = (MyData(e)(8))
Cells(記録R, "AE").Value = (MyData(e)(9))
Cells(記録R, "AH").Value = (MyData(e)(10))
記録R = 記録R + 1
Next e
Erase MyData ’←初期化
MyErr:
On Error GoTo 0
Next i
Else
MsgBox "指定ファイルが見つからない為、処理を終了します"
End If
|
|
Tacchi
- 11/3/30(水) 14:11 -
