| |
配列の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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
