[ExcelVBA] 動的配列における初期要素の扱いについて

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar

アドベントカレンダー 2日目

問題点：
動的配列でReDimする前に一番最後の要素を
調べようとするとエラーとなるので
どうするの？

って話ですけど、
一番てっとりばやいのは、配列の要素を管理する変数を作って
追加する時にインクリメントしてあげればよいわけですが
別関数に処理をまかせ、特定の条件の時のみ配列に追加する
となると、いちいち配列と、配列の要素数を管理する変数を
毎回引き渡すとなるとちょっと美しくないですよね。

そんなわけで、配列の要素数を管理する変数なしで行うとしたら
SGN関数をつかって、配列の宣言がされてなかったら0が返ってくる修正を利用して処理を分岐するか
On Error Resume Nextを使ってUboundで最終要素にアクセスしてエラーがあれば0でReDimするって
方法あたりが考えられますよね。


たとえば、こんな感じ。
以下は、AddEven関数内で5回ループし、偶数だったら配列に追加する処理です。

view plainprint?

1. Option Explicit  
2.   
3. Sub SampleCode()  
4.     Dim EvenNumber()    As String  
5.   
6.     'SGN関数を使った場合  
7.     Call AddEvenNumber1(EvenNumber)  
8.   
9.     '配列の初期化  
10.     Erase EvenNumber  
11.       
12.     'On Error Resume Nextを使った場合  
13.     Call AddEvenNumber2(EvenNumber)  
14. End Sub  
15.   
16. Sub AddEvenNumber1(ByRef EvenNumber() As String)  
17.     Dim E               As Long  
18.     Dim i               As Integer  
19.     Dim RandomNumber    As Integer  
20.           
21.     Randomize  
22.       
23.     For i = 1 To 5  
24.         '1～100の乱数を発生  
25.         RandomNumber = Int(Rnd() * 100) + 1  
26.           
27.         '奇数の時は次のループへ  
28.         If RandomNumber Mod 2 = 1 Then GoTo NextForLoop  
29.           
30.         If Sgn(EvenNumber) = 0 Then  
31.             E = 0  
32.               
33.         Else  
34.             E = UBound(EvenNumber) + 1  
35.           
36.         End If  
37.   
38.         ReDim Preserve EvenNumber(E)  
39.         EvenNumber(E) = RandomNumber  
40. NextForLoop:  
41.     Next  
42.       
43. End Sub  
44.   
45. Sub AddEvenNumber2(ByRef EvenNumber() As String)  
46.     Dim i               As Integer  
47.     Dim RandomNumber    As Integer  
48.           
49.     Randomize  
50.       
51.     For i = 1 To 5  
52.         '1～100の乱数を発生  
53.         RandomNumber = Int(Rnd() * 100) + 1  
54.           
55.         '奇数の時は次のループへ  
56.         If RandomNumber Mod 2 = 1 Then GoTo NextForLoop  
57.           
58.         On Error Resume Next  
59.         ReDim Preserve EvenNumber(UBound(EvenNumber) + 1)  
60.         If Err.Number <> 0 Then ReDim Preserve EvenNumber(0)  
61.         On Error GoTo 0  
62.           
63.         EvenNumber(UBound(EvenNumber)) = RandomNumber  
64. NextForLoop:  
65.     Next  
66.       
67. End Sub  

Option Explicit

Sub SampleCode()
    Dim EvenNumber()    As String

    'SGN関数を使った場合
    Call AddEvenNumber1(EvenNumber)

    '配列の初期化
    Erase EvenNumber
    
    'On Error Resume Nextを使った場合
    Call AddEvenNumber2(EvenNumber)
End Sub

Sub AddEvenNumber1(ByRef EvenNumber() As String)
    Dim E               As Long
    Dim i               As Integer
    Dim RandomNumber    As Integer
        
    Randomize
    
    For i = 1 To 5
        '1～100の乱数を発生
        RandomNumber = Int(Rnd() * 100) + 1
        
        '奇数の時は次のループへ
        If RandomNumber Mod 2 = 1 Then GoTo NextForLoop
        
        If Sgn(EvenNumber) = 0 Then
            E = 0
            
        Else
            E = UBound(EvenNumber) + 1
        
        End If

        ReDim Preserve EvenNumber(E)
        EvenNumber(E) = RandomNumber
NextForLoop:
    Next
    
End Sub

Sub AddEvenNumber2(ByRef EvenNumber() As String)
    Dim i               As Integer
    Dim RandomNumber    As Integer
        
    Randomize
    
    For i = 1 To 5
        '1～100の乱数を発生
        RandomNumber = Int(Rnd() * 100) + 1
        
        '奇数の時は次のループへ
        If RandomNumber Mod 2 = 1 Then GoTo NextForLoop
        
        On Error Resume Next
        ReDim Preserve EvenNumber(UBound(EvenNumber) + 1)
        If Err.Number <> 0 Then ReDim Preserve EvenNumber(0)
        On Error GoTo 0
        
        EvenNumber(UBound(EvenNumber)) = RandomNumber
NextForLoop:
    Next
    
End Sub

では、せっかくなんでどのやり方が一番最速か調べてみます。
純粋に配列の初期要素問題がどう影響するかだけを見たいので
乱数やら、偶数の時だけ配列に追加とかは除外します。
単純に10万回ループさせて値を追加し続けてみます。
１．SGN関数を使う

２．On Error Resume Nextを使う

３．要素数管理用の変数を使う(引数に渡す)
→IF分を減らした方が早いんじゃないかという疑惑から

４．要素数管理用の変数を使う(引数で渡さない：グローバル宣言)
→IF分なくしても、引数を増やすと時間がかかるんじゃないかという疑惑から。

ソースコードは最後に掲載

	1.SGN	2.Error	3.要素数管理	4.要素数管理
１回目	1.047	0.812	0.703	0.734
２回目	0.734	0.687	0.750	0.735
３回目	0.609	0.656	0.703	0.796
４回目	0.719	0.766	0.703	0.703
５回目	0.562	0.718	0.875	0.828
６回目	0.563	0.797	0.735	0.750
７回目	0.578	0.750	0.750	0.750
８回目	0.547	0.797	0.953	0.703
９回目	0.594	0.812	0.781	0.656
10回目	0.516	0.859	0.844	0.750
平均	0.6469	0.7654	0.7797	0.7405

一応、SGNを使った場合が一番早いようですが、
10万回ループで0.1秒差なので、どれを使ったもかわらないですね。


ソースコード：

view plainprint?

1. Option Explicit  
2.   
3. Dim EE As Long  
4.   
5. Declare Function GetTickCount Lib "kernel32" () As Long  
6.   
7. Sub SampleCode()  
8.     Dim BaseTime        As Long  
9.     Dim E               As Long: E = -1  
10.     Dim EvenNumber()    As String  
11.   
12.     '基準タイム  
13.     BaseTime = GetTickCount  
14.   
15.     'SGN関数を使った場合  
16.     Call AddArray1(EvenNumber)  
17.   
18.     Debug.Print "SGN :" & (GetTickCount - BaseTime) / 1000  
19.   
20.     '配列の初期化  
21.     Erase EvenNumber  
22.       
23.     '基準タイム  
24.     BaseTime = GetTickCount  
25.       
26.     'On Error Resume Nextを使った場合  
27.     Call AddArray2(EvenNumber)  
28.   
29.     Debug.Print "Err :" & (GetTickCount - BaseTime) / 1000  
30.   
31.     '配列の初期化  
32.     Erase EvenNumber  
33.       
34.     '基準タイム  
35.     BaseTime = GetTickCount  
36.       
37.     'On Error Resume Nextを使った場合  
38.     Call AddArray3(EvenNumber, E)  
39.   
40.     Debug.Print "要素:" & (GetTickCount - BaseTime) / 1000  
41.   
42.     '配列の初期化  
43.     Erase EvenNumber  
44.       
45.     EE = -1  
46.       
47.     '基準タイム  
48.     BaseTime = GetTickCount  
49.       
50.     'On Error Resume Nextを使った場合  
51.     Call AddArray4(EvenNumber)  
52.   
53.     Debug.Print "要素:" & (GetTickCount - BaseTime) / 1000  
54.       
55.       
56.     Debug.Print "---"  
57. End Sub  
58.   
59. Sub AddArray1(ByRef EvenNumber() As String)  
60.     Dim E               As Long  
61.     Dim i               As Long  
62.     Dim RandomNumber    As Integer  
63.       
64.     For i = 1 To 100000  
65.       
66.         If Sgn(EvenNumber) = 0 Then  
67.             E = 0  
68.         Else  
69.             E = UBound(EvenNumber) + 1  
70.         End If  
71.   
72.         ReDim Preserve EvenNumber(E)  
73.         EvenNumber(E) = i  
74. NextForLoop:  
75.     Next  
76.       
77. End Sub  
78.   
79. Sub AddArray2(ByRef EvenNumber() As String)  
80.     Dim i               As Long  
81.     Dim RandomNumber    As Integer  
82.       
83.     For i = 1 To 100000  
84.         On Error Resume Next  
85.         ReDim Preserve EvenNumber(UBound(EvenNumber) + 1)  
86.         If Err.Number <> 0 Then ReDim Preserve EvenNumber(0)  
87.         On Error GoTo 0  
88.           
89.         EvenNumber(UBound(EvenNumber)) = i  
90. NextForLoop:  
91.     Next  
92.       
93. End Sub  
94.   
95. Sub AddArray3(ByRef EvenNumber() As String, ByRef E As Long)  
96.     Dim i               As Long  
97.     Dim RandomNumber    As Integer  
98.       
99.     For i = 1 To 100000  
100.         E = E + 1  
101.         ReDim Preserve EvenNumber(E)  
102.         EvenNumber(E) = i  
103. NextForLoop:  
104.     Next  
105.       
106. End Sub  
107.   
108. Sub AddArray4(ByRef EvenNumber() As String)  
109.     Dim i               As Long  
110.     Dim RandomNumber    As Integer  
111.       
112.     For i = 1 To 100000  
113.         EE = EE + 1  
114.         ReDim Preserve EvenNumber(EE)  
115.         EvenNumber(EE) = i  
116. NextForLoop:  
117.     Next  
118.       
119. End Sub  

Option Explicit

Dim EE As Long

Declare Function GetTickCount Lib "kernel32" () As Long

Sub SampleCode()
    Dim BaseTime        As Long
    Dim E               As Long: E = -1
    Dim EvenNumber()    As String

    '基準タイム
    BaseTime = GetTickCount

    'SGN関数を使った場合
    Call AddArray1(EvenNumber)

    Debug.Print "SGN :" & (GetTickCount - BaseTime) / 1000

    '配列の初期化
    Erase EvenNumber
    
    '基準タイム
    BaseTime = GetTickCount
    
    'On Error Resume Nextを使った場合
    Call AddArray2(EvenNumber)

    Debug.Print "Err :" & (GetTickCount - BaseTime) / 1000

    '配列の初期化
    Erase EvenNumber
    
    '基準タイム
    BaseTime = GetTickCount
    
    'On Error Resume Nextを使った場合
    Call AddArray3(EvenNumber, E)

    Debug.Print "要素:" & (GetTickCount - BaseTime) / 1000

    '配列の初期化
    Erase EvenNumber
    
    EE = -1
    
    '基準タイム
    BaseTime = GetTickCount
    
    'On Error Resume Nextを使った場合
    Call AddArray4(EvenNumber)

    Debug.Print "要素:" & (GetTickCount - BaseTime) / 1000
    
    
    Debug.Print "---"
End Sub

Sub AddArray1(ByRef EvenNumber() As String)
    Dim E               As Long
    Dim i               As Long
    Dim RandomNumber    As Integer
    
    For i = 1 To 100000
    
        If Sgn(EvenNumber) = 0 Then
            E = 0
        Else
            E = UBound(EvenNumber) + 1
        End If

        ReDim Preserve EvenNumber(E)
        EvenNumber(E) = i
NextForLoop:
    Next
    
End Sub

Sub AddArray2(ByRef EvenNumber() As String)
    Dim i               As Long
    Dim RandomNumber    As Integer
    
    For i = 1 To 100000
        On Error Resume Next
        ReDim Preserve EvenNumber(UBound(EvenNumber) + 1)
        If Err.Number <> 0 Then ReDim Preserve EvenNumber(0)
        On Error GoTo 0
        
        EvenNumber(UBound(EvenNumber)) = i
NextForLoop:
    Next
    
End Sub

Sub AddArray3(ByRef EvenNumber() As String, ByRef E As Long)
    Dim i               As Long
    Dim RandomNumber    As Integer
    
    For i = 1 To 100000
        E = E + 1
        ReDim Preserve EvenNumber(E)
        EvenNumber(E) = i
NextForLoop:
    Next
    
End Sub

Sub AddArray4(ByRef EvenNumber() As String)
    Dim i               As Long
    Dim RandomNumber    As Integer
    
    For i = 1 To 100000
        EE = EE + 1
        ReDim Preserve EvenNumber(EE)
        EvenNumber(EE) = i
NextForLoop:
    Next
    
End Sub

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar