Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

13601 / 76738

←次へ　｜　前へ→


	【68640】Re:動的配列の初期化について

Hirofumi - 11/3/31(木) 18:36 -


	引用なし

	パスワード

配列のIndex最大値をzで表しているのだから
こんなんでも善いのでは？

Option Explicit

Public Sub Test()

　　Dim i As Long
　　Dim z As Long
　　Dim q As Long
　　Dim x As Long
　　Dim e As Long
　　
　　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()
　　Dim MyData() As Variant
　　
　　'使用原紙の保管場所
　　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 IsEmpty(.Cells(i, "Y").Value) 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
　　　　　　　　　　　　　　　　z = z + 1
　　　　　　　　　　　　　　　　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)
　　　　　　For e = 0 To z 'zが-1なら（MyDataに値がないとき）Forは回らない
　　　　　　　　記録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　'←初期化
　　　　　　z = -1
'MyErr:

'　　　　　　On Error GoTo 0
　　　　Next i
　　Else
　　　　MsgBox "指定ファイルが見つからない為、処理を終了します"
　　End If

End Sub

0 hits

▼

【68618】動的配列の初期化について Tacchi 11/3/30(水) 14:11