配列 | Excel作業をVBAで効率化 https://vbabeginner.net いつものExcel作業はVBAを使えば数秒で終わるかもしれませんよ Sun, 10 Nov 2024 14:44:37 +0000 ja hourly 1 https://wordpress.org/?v=6.6.2 https://vbabeginner.net/wp-content/uploads/2019/02/favicon-150x150.png 配列 | Excel作業をVBAで効率化 https://vbabeginner.net 32 32 VBAの配列の終端にデータを追加する(push) https://vbabeginner.net/array-push/ Sun, 28 Nov 2021 06:25:44 +0000 https://vbabeginner.net/?p=6350 VBAには配列のpushメソッドは無い

主にWeb系で扱うプログラミング言語には配列の操作を行うメソッドがあります。ここでは配列の終端にデータを追加する処理をVBA用にした関数を紹介します

終端に追加する処理はプログラミング言語によって関数名は異なりますが、JavaScriptやPHPやRubyなど一般的には「push」という名前が多いため、以下で紹介する関数はそれに合わせて「Arraypush」という関数名にしています。

配列の先頭や終端にデータの追加や削除を行うには

VBAの配列は単にデータを複数保持しているだけですが、現在主流のプログラミング言語では配列はクラスとして管理されており、配列を操作するための関数が複数用意されていることが一般的です。

プログラミング言語によって関数名は異なりますが、配列を操作する関数として一般的には以下のようなものがあります。

関数名 用途 関数戻り値
shift 配列の先頭データを切り取る 切り取った先頭データ
unshift 配列の先頭にデータを追加する 追加後の配列要素数
pop 配列の終端データを切り取る 切り取った終端データ
push 配列の終端にデータを追加する 追加後の配列要素数

これらの関数をVBAでも使えるように以下に説明します。なお、それぞれの実装方法が異なるためページを分けて説明しています。

配列の終端にデータを追加するコード(push)

以下のコードは配列の終端の位置にデータを追加する関数です。JavaScriptやPHPなどでのpushメソッドになります。

JavaScriptなどのpushメソッドは複数のデータを1度に追加できますが、ここでは追加できるデータは1つに制限しています。

使い方は、関数の引数の1つ目に配列、2つ目に追加するデータを指定します。関数の戻り値はデータ追加後の配列の要素数です。

戻り値の要素数について補足します。VBAの場合の配列の要素数はUBound関数を使うことが一般的で、UBound関数は配列の要素数ではなく配列終端の要素位置を返すため、例えば[0] [1] [2]の3つのデータを持つ配列でもUBound関数は3ではなく2を返します。それに合わせて厳密な要素数ではなくUBound関数の値を関数戻り値として返却しています。それが気に入らない場合は戻り値に+1した値を返すようにいじってください。

配列は1次元配列を対象としており、配列のデータ型はなんでもOKです。なんでもOKにするために、オブジェクト型かどうかの判定をIsObject関数で行い、オブジェクト型であれば値の代入方法でSetを使い、そうでなければ=で代入するようにしています。

IsObject関数の詳細については「VBAのオブジェクト変数かどうかを判定する(IsObject)」をご参照ください。

引数が配列でない場合は処理しません。

'// 終端に追加
'// 引数1:配列
'// 引数2:追加するデータ
'// 戻り値:追加後の配列要素数(UBound関数結果)
Function ArrayPush(ar As Variant, addValue As Variant) As Long
    '// 引数が配列でない場合
    If IsArray(ar) = False Then
        '// 処理せず抜ける
        Exit Function
    End If
    
    '// 配列要素数を取得
    Dim iSize   As Long         '// 配列サイズ
    
    '// 配列サイズを拡張後のサイズで取得
    iSize = UBound(ar) + 1
    
    '// 拡張
    ReDim Preserve ar(iSize)
    
    Dim i       As Long         '// ループカウンタ
    
    '// オブジェクト型変数の場合
    If IsObject(ar(0)) = True Then
        '// 終端に現在ループ値を設定
        Set ar(iSize) = addValue
    '// プリミティブ型変数(IntegerやStringなど)の場合
    Else
        '// 終端に現在ループ値を設定
        ar(iSize) = addValue
    End If
    
    '// 要素数を返却
    ArrayPush = UBound(ar)
End Function

使い方

上のArraypush関数をString型の配列とRange型の配列のそれぞれを使った場合の利用例です。

引数に配列と追加するデータを渡すだけです。戻り値として配列要素数を受け取っています。検証用として、データ追加後の配列の各要素を出力しています。

Sub ArrayPushTest()
    Dim ar() As String
    Dim s, c
    
    '// String型配列
    ReDim ar(3)
    ar(0) = "abc"
    ar(1) = "bbb"
    ar(2) = "ccc"
    ar(3) = "ddd"
    '// 先頭に追加
    c = ArrayPush(ar, "AAA")
    Debug.Print c       '// 要素数を出力
    For Each s In ar
        Debug.Print s
    Next
    
    '// 要素が1つの配列
    ReDim ar(0)
    ar(0) = "!"
    '// 先頭に追加
    c = ArrayPush(ar, "BBB")
    Debug.Print c       '// 要素数を出力
    For Each s In ar
        Debug.Print s
    Next
    
    '// Range型配列
    Dim r() As Range
    ReDim r(2)
    Set r(0) = Range("A1")
    Set r(1) = Range("B2")
    Set r(2) = Range("C3:D4")
    '// 先頭に追加
    c = ArrayPush(r, Range("C1"))
    Debug.Print c
    For Each s In r
        Debug.Print s.Address(False, False)
    Next
End Sub

実行結果
4
abc
bbb
ccc
ddd
AAA
1
!
BBB
3
A1
B2
C3:D4
C1

]]>
VBAの配列の終端データを切り取る(pop) https://vbabeginner.net/array-pop/ Sun, 28 Nov 2021 06:18:47 +0000 https://vbabeginner.net/?p=6348 VBAには配列のpopメソッドは無い

主にWeb系で扱うプログラミング言語には配列の操作を行うメソッドがあります。ここでは配列の終端にデータを追加する処理をVBA用にした関数を紹介します

終端に追加する処理はプログラミング言語によって関数名は異なりますが、JavaScriptやPHPやRubyなど一般的には「pop」という名前が多いため、以下で紹介する関数はそれに合わせて「ArrayPop」という関数名にしています。

配列の先頭や終端にデータの追加や削除を行うには

VBAの配列は単にデータを複数保持しているだけですが、現在主流のプログラミング言語では配列はクラスとして管理されており、配列を操作するための関数が複数用意されていることが一般的です。

プログラミング言語によって関数名は異なりますが、配列を操作する関数として一般的には以下のようなものがあります。

関数名 用途 関数戻り値
shift 配列の先頭データを切り取る 切り取った先頭データ
unshift 配列の先頭にデータを追加する 追加後の配列要素数
pop 配列の終端データを切り取る 切り取った終端データ
push 配列の終端にデータを追加する 追加後の配列要素数

これらの関数をVBAでも使えるように以下に説明します。なお、それぞれの実装方法が異なるためページを分けて説明しています。

配列の終端にデータを追加するコード(pop)

以下のコードは配列の終端のデータを切り取る関数です。JavaScriptやPHPなどでのpopメソッドになります。

VBAで配列の終端にデータを追加する場合、Redim Preserveで配列を拡張して実施します。popの場合も考え方は同じです。

使い方ですが、関数の引数には配列を渡し、関数の戻り値は切り取ったデータを返します。関数実行後は配列の要素数は終端データが無くなるため1減ります。

配列は1次元配列を対象としており、配列のデータ型はなんでもOKです。なんでもOKにするために、オブジェクト型かどうかの判定をIsObject関数で行い、オブジェクト型であれば値の代入方法でSetを使い、そうでなければ=で代入するようにしています。

IsObject関数の詳細については「VBAのオブジェクト変数かどうかを判定する(IsObject)」をご参照ください。

引数が配列でない場合は処理しません。また、配列の要素がない場合は終端データを戻り値用に切り取り、配列をクリアしています。

'// 終端を切り取る
'// 引数:配列
'// 戻り値:切り取った先頭データ
Function ArrayPop(ar As Variant)
    '// 引数が配列でない場合
    If IsArray(ar) = False Then
        '// 処理せず抜ける
        Exit Function
    End If
    
    '// 配列要素数を取得
    Dim iSize   As Long         '// 配列サイズ
    iSize = UBound(ar)
    
    '// 配列の終端を戻り値として取得
    '// オブジェクト型変数の場合
    If IsObject(ar(iSize)) = True Then
        Set ArrayPop = ar(iSize)
    '// プリミティブ型変数(IntegerやStringなど)の場合
    Else
        ArrayPop = ar(iSize)
    End If
    
    '// 配列にデータが複数ない場合
    If iSize = 0 Then
        '// 配列をクリア(終端データを削除)して処理を抜ける
        ReDim ar(0)
        Exit Function
    End If
    
    '// 終端の要素を削除
    ReDim Preserve ar(UBound(ar) - 1)
End Function

使い方

上のArrayPop関数をString型の配列とRange型の配列のそれぞれの利用例です。

引数に配列を渡すだけですが、戻り値の受け取り方が配列のデータ型がオブジェクト型かそうでないかの2通りあります。

以下のコードのString型はプロパティやメソッドを持たないプリミティブ型の1つで、ArrayPop関数の結果を=の代入で取得できます。Range型はクラスのためオブジェクト型の1つになり、ArrayPop関数の結果をSetステートメントを使って取得します。

Sub ArrayPopTest()
    Dim ar() As String
    Dim s
    
    '// String型配列
    ReDim ar(3)
    ar(0) = "abc"
    ar(1) = "bbb"
    ar(2) = "ccc"
    ar(3) = "ddd"
    '// 終端を切り取り
    s = ArrayPop(ar)
    Debug.Print s       '// 切り取った ddd を出力
    Debug.Print UBound(ar)
    
    '// 要素が1つの配列
    ReDim ar(0)
    ar(0) = "!"
    '// 終端を切り取り
    s = ArrayPop(ar)
    Debug.Print s       '// 切り取った ! を出力
    Debug.Print UBound(ar)
    
    '// Range型配列
    Dim r() As Range
    ReDim r(2)
    Dim ss As Range
    Set r(0) = Range("A1")
    Set r(1) = Range("B2")
    Set r(2) = Range("C3:D4")
    '// 終端を切り取り
    Set ss = ArrayPop(r)
    Debug.Print ss.Address(False, False)    '// 切り取ったセルのアドレスC3:D4を出力
    Debug.Print UBound(r)
End Sub

実行結果
ddd
2
!
0
C3:D4
1

]]>
VBAの配列の先頭にデータを追加する(unshift) https://vbabeginner.net/array-unshift/ Sun, 28 Nov 2021 05:30:35 +0000 https://vbabeginner.net/?p=6346 VBAには配列のunshiftメソッドは無い

主にWeb系で扱うプログラミング言語には配列の操作を行うメソッドがあります。ここでは配列の先頭にデータを追加する処理をVBA用にした関数を紹介します

先頭に追加する処理はプログラミング言語によって関数名は異なりますが、JavaScriptやPHPやRubyなど一般的には「unshift」という名前が多いため、以下で紹介する関数はそれに合わせて「ArrayUnShift」という関数名にしています。

配列の先頭や終端にデータの追加や削除を行うには

VBAの配列は単にデータを複数保持しているだけですが、現在主流のプログラミング言語では配列はクラスとして管理されており、配列を操作するための関数が複数用意されていることが一般的です。

プログラミング言語によって関数名は異なりますが、配列を操作する関数として一般的には以下のようなものがあります。

関数名 用途 関数戻り値
shift 配列の先頭データを切り取る 切り取った先頭データ
unshift 配列の先頭にデータを追加する 追加後の配列要素数
pop 配列の終端データを切り取る 切り取った終端データ
push 配列の終端にデータを追加する 追加後の配列要素数

これらの関数をVBAでも使えるように以下に説明します。なお、それぞれの実装方法が異なるためページを分けて説明しています。

配列の先頭にデータを追加するコード(unshift)

以下のコードは配列の先頭(配列のインデックスが0)の位置にデータを追加する関数です。JavaScriptやPHPなどでのunshiftメソッドになります。

JavaScriptなどのunshiftメソッドは複数のデータを1度に追加できますが、ここでは追加できるデータは1つに制限しています。

使い方は、関数の引数の1つ目に配列、2つ目に追加するデータを指定します。関数の戻り値はデータ追加後の配列の要素数です。

戻り値の要素数について補足します。VBAの場合の配列の要素数はUBound関数を使うことが一般的で、UBound関数は配列の要素数ではなく配列終端の要素位置を返すため、例えば[0] [1] [2]の3つのデータを持つ配列でもUBound関数は3ではなく2を返します。それに合わせて厳密な要素数ではなくUBound関数の値を関数戻り値として返却しています。それが気に入らない場合は戻り値に+1した値を返すようにいじってください。

配列は1次元配列を対象としており、配列のデータ型はなんでもOKです。なんでもOKにするために、オブジェクト型かどうかの判定をIsObject関数で行い、オブジェクト型であれば値の代入方法でSetを使い、そうでなければ=で代入するようにしています。

IsObject関数の詳細については「VBAのオブジェクト変数かどうかを判定する(IsObject)」をご参照ください。

引数が配列でない場合は処理しません。

'// 先頭に追加
'// 引数1:配列
'// 引数2:追加するデータ
'// 戻り値:追加後の配列要素数(UBound関数結果)
Function ArrayUnShift(ar As Variant, addValue As Variant) As Long
    '// 引数が配列でない場合
    If IsArray(ar) = False Then
        '// 処理せず抜ける
        Exit Function
    End If
    
    '// 配列要素数を取得
    Dim iSize   As Long         '// 配列サイズ
    
    '// 配列サイズを拡張後のサイズで取得
    iSize = UBound(ar) + 1
    
    '// 拡張
    ReDim Preserve ar(iSize)
    
    Dim i       As Long         '// ループカウンタ
    
    '// 最後尾の直前から先頭に向かってループ
    For i = iSize - 1 To 0 Step -1
        '// オブジェクト型変数の場合
        If IsObject(ar(i)) = True Then
            '// 次の要素に現在ループ値を設定
            Set ar(i + 1) = ar(i)
        '// プリミティブ型変数(IntegerやStringなど)の場合
        Else
            '// 次の要素に現在ループ値を設定
            ar(i + 1) = ar(i)
        End If
    Next
    
    '// 配列の先頭に引数の追加値を設定
    '// オブジェクト型変数の場合
    If IsObject(ar(0)) = True Then
        '// 先頭に現在ループ値を設定
        Set ar(0) = addValue
    '// プリミティブ型変数(IntegerやStringなど)の場合
    Else
        '// 先頭に現在ループ値を設定
        ar(0) = addValue
    End If
    
    '// 要素数を返却
    ArrayUnShift = UBound(ar)
End Function

使い方

上のArrayUnShift関数をString型の配列とRange型の配列のそれぞれを使った場合の利用例です。

引数に配列と追加するデータを渡すだけです。戻り値として配列要素数を受け取っています。検証用として、データ追加後の配列の各要素を出力しています。

Sub ArrayUnShiftTest()
    Dim ar() As String
    Dim s, c
    
    '// String型配列
    ReDim ar(3)
    ar(0) = "abc"
    ar(1) = "bbb"
    ar(2) = "ccc"
    ar(3) = "ddd"
    '// 先頭に追加
    c = ArrayUnShift(ar, "AAA")
    Debug.Print c       '// 要素数を出力
    For Each s In ar
        Debug.Print s
    Next
    
    '// 要素が1つの配列
    ReDim ar(0)
    ar(0) = "!"
    '// 先頭に追加
    c = ArrayUnShift(ar, "BBB")
    Debug.Print c       '// 要素数を出力
    For Each s In ar
        Debug.Print s
    Next
    
    '// Range型配列
    Dim r() As Range
    ReDim r(2)
    Set r(0) = Range("A1")
    Set r(1) = Range("B2")
    Set r(2) = Range("C3:D4")
    '// 先頭に追加
    c = ArrayUnShift(r, Range("C1"))
    Debug.Print c
    For Each s In r
        Debug.Print s.Address(False, False)
    Next
End Sub

実行結果
4
AAA 追加データ
abc
bbb
ccc
ddd
1
BBB 追加データ
!
3
C1 追加データ
A1
B2
C3:D4

]]>
VBAの配列の先頭データを切り取る(shift) https://vbabeginner.net/array-shift/ Sun, 28 Nov 2021 04:36:44 +0000 https://vbabeginner.net/?p=6340 VBAには配列のshiftメソッドは無い

主にWeb系で扱うプログラミング言語には配列の操作を行うメソッドがあります。ここでは配列の先頭データを切り取る処理をVBA用にした関数を紹介します

先頭を切り取る処理はプログラミング言語によって関数名は異なりますが、JavaScriptやPHPやRubyなど一般的には「shift」という名前が多いため、以下で紹介する関数はそれに合わせて「ArrayShift」という関数名にしています。

配列の先頭や終端にデータの追加や削除を行うには

VBAの配列は単にデータを複数保持しているだけですが、現在主流のプログラミング言語では配列はクラスとして管理されており、配列を操作するための関数が複数用意されていることが一般的です。

プログラミング言語によって関数名は異なりますが、配列を操作する関数として一般的には以下のようなものがあります。

関数名 用途 関数戻り値
shift 配列の先頭データを切り取る 切り取った先頭データ
unshift 配列の先頭にデータを追加する 追加後の配列要素数
pop 配列の終端データを切り取る 切り取った終端データ
push 配列の終端にデータを追加する 追加後の配列要素数

これらの関数をVBAでも使えるように以下に説明します。なお、それぞれの実装方法が異なるためページを分けて説明しています。

配列の先頭データを切り取るコード(shift)

以下のコードは配列の先頭(配列のインデックスが0)のデータを切り取る関数です。JavaScriptやPHPなどでのshiftメソッドになります。

使い方ですが、関数の引数には配列を渡し、関数の戻り値は切り取ったデータを返します。関数実行後は配列の要素数は先頭データが無くなるため1減ります。

配列は1次元配列を対象としており、配列のデータ型はなんでもOKです。なんでもOKにするために、オブジェクト型かどうかの判定をIsObject関数で行い、オブジェクト型であれば値の代入方法でSetを使い、そうでなければ=で代入するようにしています。

IsObject関数の詳細については「VBAのオブジェクト変数かどうかを判定する(IsObject)」をご参照ください。

引数が配列でない場合は処理しません。また、配列の要素がない場合は先頭データを戻り値用に切り取り、配列をクリアしています。

'// 先頭を切り取る
'// 引数:配列
'// 戻り値:切り取った先頭データ
Function ArrayShift(ar As Variant) As Variant
    '// 引数が配列でない場合
    If IsArray(ar) = False Then
        '// 処理せず抜ける
        Exit Function
    End If
    
    '// 配列要素数を取得
    Dim iSize   As Long         '// 配列サイズ
    iSize = UBound(ar)
    
    '// 配列の先頭を戻り値として取得
    '// オブジェクト型変数の場合
    If IsObject(ar(0)) = True Then
        Set ArrayShift = ar(0)
    '// プリミティブ型変数(IntegerやStringなど)の場合
    Else
        ArrayShift = ar(0)
    End If
    
    '// 配列にデータが複数ない場合
    If iSize = 0 Then
        '// 配列をクリア(先頭データを削除)して処理を抜ける
        ReDim ar(0)
        Exit Function
    End If
    
    Dim i       As Long         '// ループカウンタ
    
    '// 配列要素数ループ(2番目の要素から処理する)
    For i = 1 To iSize
        '// オブジェクト型変数の場合
        If IsObject(ar(i)) = True Then
            '// 1つ前の要素に現在ループ値を設定
            Set ar(i - 1) = ar(i)
        '// プリミティブ型変数(IntegerやStringなど)の場合
        Else
            '// 1つ前の要素に現在ループ値を設定
            ar(i - 1) = ar(i)
        End If
    Next
    
    '// 終端の要素を削除
    ReDim Preserve ar(UBound(ar) - 1)
End Function

使い方

上のArrayShift関数をString型の配列とRange型の配列のそれぞれを使った場合の利用例です。

引数に配列を渡すだけですが、戻り値の受け取り方が配列のデータ型がオブジェクト型かそうでないかの2通りあります。

以下のコードのString型はプロパティやメソッドを持たないプリミティブ型の1つで、ArrayShift関数の結果を=の代入で取得できます。Range型はクラスのためオブジェクト型の1つになり、ArrayShift関数の結果をSetステートメントを使って取得します。

Sub ArrayShiftTest()
    Dim ar() As String
    Dim s
    
    '// String型配列
    ReDim ar(3)
    ar(0) = "abc"
    ar(1) = "bbb"
    ar(2) = "ccc"
    ar(3) = "ddd"
    '// 先頭を切り取り
    s = ArrayShift(ar)
    Debug.Print s       '// 切り取った abc を出力
    Debug.Print UBound(ar)
    
    '// 要素が1つの配列
    ReDim ar(0)
    ar(0) = "!"
    '// 先頭を切り取り
    s = ArrayShift(ar)
    Debug.Print s       '// 切り取った ! を出力
    Debug.Print UBound(ar)
    
    '// Range型配列
    Dim r() As Range
    ReDim r(2)
    Dim ss As Range
    Set r(0) = Range("A1")
    Set r(1) = Range("B2")
    Set r(2) = Range("C3:D4")
    '// 先頭を切り取り
    Set ss = ArrayShift(r)
    Debug.Print ss.Address(False, False)    '// 切り取ったセルのアドレスA1を出力
    Debug.Print UBound(r)
End Sub

実行結果
abc
2
!
0
A1
1

]]>
VBAの配列の任意の位置への追加や削除を行う https://vbabeginner.net/array-any-position/ Thu, 05 Mar 2020 15:36:36 +0000 https://vbabeginner.net/?p=4710 配列の任意の位置へのデータの追加や削除を行うには

VBAの配列はRedim Preserve構文で終端より先の領域を拡張することはできますが、配列の途中の部分にデータを挿入したり削除したりする仕組みはありません

一般的に一連のデータの途中にデータの追加や削除を行いたい場合は連結リストという仕組みを利用しますが、VBAには連結リストが実装されていません。

連結リストがどうしても必要であればクラスを自作するとかの話になります。ただ、そこまではちょっと面倒です。

ここでは、連結リストクラスを自作するのが面倒なので、配列を使って任意の位置にデータを追加したり、任意の位置を削除したりする方法を紹介します。

紹介しているデータ追加関数とデータ削除関数はどちらも処理速度は最小O(1)から最大O(n)(n=配列要素数+1)の範囲になります。

配列の任意の位置にデータを追加する関数

以下の関数は配列の任意の位置にデータを追加します。追加された箇所以降は1つ後ろのインデックスにシフト(移動)します。

引数が3つあり、「配列」「追加データ」「追加する位置(配列のインデックス値)」を指定します。追加データのデータ型はなんでもOKです。

Sub InsertToArray(a_Ary, a_Data, a_iPosition)
    Dim i                       '// ループカウンタ
    Dim iCount                  '// 配列要素数
    
    '// 引数配列要素数を取得(拡張分として1を加算)
    iCount = UBound(a_Ary) + 1
    
    '// 配列の領域を拡張
    ReDim Preserve a_Ary(iCount)
    
    '// 設定位置が配列要素より大きい場合あh配列最終要素位置に設定する
    If a_iPosition > iCount Then
        a_iPosition = iCount
    End If
    
    '// 配列終端から先頭に向かって追加位置までループ
    For i = iCount To a_iPosition + 1 Step -1
        '// 1つ前の値を現在の値としてセット(1つ後ろにシフト)
        Call SetValue(a_Ary(i - 1), a_Ary(i))
    Next
    
    '// 追加データをセット
    Call SetValue(a_Data, a_Ary(a_iPosition))
End Sub

配列の任意の位置にデータを削除する関数

以下の関数は配列の任意の位置のデータを削除します。削除された箇所以降は1つ前のインデックスにシフト(移動)します。

引数が2つあり、「配列」「削除する位置(配列のインデックス値)」を指定します。

Sub EraseToArray(a_Ary, a_iPosition)
    Dim i                       '// ループカウンタ
    Dim iCount                  '// 配列要素数
    
    '// 引数配列要素数を取得
    iCount = UBound(a_Ary)
    
    '// 指定位置から終端直前までループ
    For i = a_iPosition To iCount - 1
        Call SetValue(a_Ary(i + 1), a_Ary(i))
    Next
    
    '// 領域を1つ削除(終端を削除)
    ReDim Preserve a_Ary(iCount - 1)
End Sub

データコピー関数

上記の2つ関数はどちらも配列のデータ型はなんでもOKにしています。

そのため、Integer型やString型などのプリミティブ型でも、Range型やDictionary型などの各種オブジェクト型でも動作します。

ただ、オブジェクト型と非オブジェクト型ではデータの代入にSetステートメントを使うかどうかというコーディングの仕方が異なるため、この関数でデータ型を判定した上でそれに応じた代入を行うようにしています。

Sub SetValue(a_From, a_To)
    Dim bType   As Boolean      '// 引数配列の種類
    
    '// 引数データ型判定
    bType = IsObject(a_From)
    
    '// オブジェクト型の場合
    If bType = True Then
        Set a_To = a_From
    '// 非オブジェクト型の場合
    Else
        a_To = a_From
    End If
End Sub

使い方

String型の配列とRange型の配列を用意して、配列の任意の要素位置にデータの追加を行い、その後任意の要素位置のデータを削除するテストコードです。

Sub InsertEraseToArrayTest()
    Dim arString()  As String   '// 文字列配列
    Dim arRange()   As Range    '// セル配列
    Dim i           As Long     '// ループカウンタ
    
    '// テスト用の初期値を設定
    ReDim arString(7)
    ReDim arRange(7)
    
    arString(0) = "a"
    arString(1) = "b"
    arString(2) = "c"
    arString(3) = "d"
    arString(4) = "e"
    arString(5) = "f"
    arString(6) = "g"
    arString(7) = "h"
    
    Set arRange(0) = Range("A1")
    Set arRange(1) = Range("A2")
    Set arRange(2) = Range("A3")
    Set arRange(3) = Range("A4")
    Set arRange(4) = Range("A5")
    Set arRange(5) = Range("A6")
    Set arRange(6) = Range("A7")
    Set arRange(7) = Range("A8")
    
    '// 配列に新規データを追加
    Call InsertToArray(arString, "abc", 1)
    Call InsertToArray(arRange, Range("G100"), 0)
    
    '// 文字列配列への追加結果を出力
    For i = 0 To UBound(arString)
        Debug.Print CStr(i) & " - " & arString(i)
    Next
    
    '// セル配列の追加結果を出力
    For i = 0 To UBound(arRange)
        Debug.Print CStr(i) & " - " & arRange(i).Address(False, False)
    Next

    Debug.Print ""
    
    '// 配列からデータを削除
    Call EraseToArray(arString, 1)
    Call EraseToArray(arRange, 0)
    
    '// 文字列配列の削除結果を出力
    For i = 0 To UBound(arString)
        Debug.Print CStr(i) & " - " & arString(i)
    Next
    
    '// セル配列の削除結果を出力
    For i = 0 To UBound(arRange)
        Debug.Print CStr(i) & " - " & arRange(i).Address(False, False)
    Next
End Sub

実行結果
0 – a
1 – abc(ここが追加部分)
2 – b
3 – c
4 – d
5 – e
6 – f
7 – g
8 – h
0 – G100(ここが追加部分)
1 – A1
2 – A2
3 – A3
4 – A4
5 – A5
6 – A6
7 – A7
8 – A8

0 – a
1 – b(ここが削除部分。2のbがこっちにシフトした。)
2 – c
3 – d
4 – e
5 – f
6 – g
7 – h
0 – A1(ここが削除部分。1のA1がこっちにシフトした。)
1 – A2
2 – A3
3 – A4
4 – A5
5 – A6
6 – A7
7 – A8

]]>
VBAで配列から重複する値を順序を変えずに削除する https://vbabeginner.net/remove-duplicate-values-array/ Sat, 05 Jan 2019 15:04:29 +0000 https://vbabeginner.net/?p=3828 Excelの機能を使うかVBAで処理するか

配列データの重複を削除する場合、大きく分けると2つの方法があります。

1つはVBAで配列のループを行い、重複の判定を行って配列の再構築を行う方法です。この方法はDictionaryクラスを使って高速化する方法と、素直に配列のループで行う方法の2通りが考えられます。

もう1つはExcelの重複の削除機能を使う方法で、処理の実体はRangeオブジェクトのRemoveDuplicatesメソッドを使う方法です。

それぞれサンプルコードも含めて紹介します。

以下では3つのコードを紹介していますが、一番おすすめなのは最初に紹介するDictionaryクラスを使う方法です。

なお、いずれの方法も元の配列の順序は維持しておくようにします。

配列の順序の維持とは、例えば「3,1,2,3,1,1」の6つのデータの重複を除去した場合に「3,1,2」とするか、ソートも行って「1,2,3」のようにしてもいいか、という話ですが、ソートをしたいのであれば重複を除去したあとにすればいい話で、コーディングの作法としては単に除去だけを行う方が都合がいい場合が多いと思います。

配列ループ+重複判定での配列再構築方法

配列ループの方法はVBAだけで完結したい場合に考え付く方法だと思います。配列の中で重複している値を削除するには、配列に格納されている値の中でどれが重複しているのかを検出する必要があります。そのため、最低1回は配列に各要素に格納されている値がなんであるかを確認する必要があります。

その際に、既に格納済みの値かどうかを確認すれば、重複しているかどうかが判定できます。この考え方をそのままコードにすると、配列の二重ループ方式になります。

ただその場合、配列の要素が多い場合に処理に時間が掛かる欠点があります。それを改善したい場合はDictionaryクラスなどのハッシュの考え方を利用します。

以下では高速に処理できるDictionaryクラスを使う方法と、処理時間が掛かる二重ループの方法の両方を紹介します。

Dictionaryクラスを使う重複除去

Dictionaryクラスを使うためには事前にVBA画面のツールメニュー→参照設定を選び、参照設定ダイアログで「Microsoft Scripting Runtime」にチェックを付けおく必要があります。

Dictionaryクラスの詳細については「VBAのDictionaryの使い方(全メソッドとプロパティ網羅)」をご参照ください。

処理の概要は、引数の配列をループして、各ループの値がDictionaryクラスにあれば何もせず、なければDictionaryクラスと編集用の配列に格納しています。

Dictionaryクラスは重複の有無判定のみに使用します。

DictionaryクラスのKeysをそのまま配列として返すことも出来ますが、その場合配列の元の順序が維持されない恐れがあるため利用せず、編集用の配列を別途利用しています。

Sub DeleteSameValue1(ar())
    Dim dic As New Dictionary   '// 重複を除いた値を格納するDictionary
    Dim i                       '// ループカウンタ1
    Dim ii                      '// ループカウンタ2
    Dim iLen                    '// 配列要素数
    Dim arEdit()                '// 編集後の配列
    
    ReDim arEdit(0)
    iLen = UBound(ar)
    
    '// 配列ループ
    For i = 0 To iLen
        '// 配列に未登録の値の場合
        If (dic.Exists(ar(i)) = False) Then
            '// Dictionaryに追加
            Call dic.Add(ar(i), ar(i))
            
            '// 重複がない値のみを編集後配列に格納する
            arEdit(UBound(arEdit)) = ar(i)
            ReDim Preserve arEdit(UBound(arEdit) + 1)
        End If
    Next
    
    '// 配列に格納済みの場合
    If (IsEmpty(arEdit(0)) = False) Then
        '// 余分な領域を削除
        ReDim Preserve arEdit(UBound(arEdit) - 1)
    End If
    
    '// 引数に編集後配列を設定
    ar = arEdit
End Sub

 

次のコードはのDeleteSameValue1関数を呼ぶテスト用の関数です。

配列に「3, 1, 2, 3, 1, 1」の6つのデータがあり、重複を除いて「3, 1, 2」で返してもらいます。

Sub DeleteSameValue1Test()
    Dim ar()
    
    ar = Array(3, 1, 2, 3, 1, 1)
    
    Call DeleteSameValue1(ar)
    
    Dim s
    For Each s In ar
        Debug.Print s
    Next
End Sub

実行結果
3
1
2

参考:配列二重ループでの重複除去

以下は引数に渡された配列から重複を除く関数(DeleteSameValue2)です。

関数内部で編集用の配列を用意します。

元の配列をループして、編集用の配列に格納されていなければ格納し、格納済みであれば重複データとして除外します。

この方式の欠点として、コードの形式として2つの配列が親子関係の二重ループになるため、処理時間も引数の配列のサイズにある程度比例することになります。

また、DictionaryクラスのExistsメソッドに該当する存在チェック処理が必要になるためどうしてもコードが長くなります。

実行結果は上と同じ結果になるため省略します。

Sub DeleteSameValue2(ar())
    Dim i                   '// ループカウンタ1
    Dim ii                  '// ループカウンタ2
    Dim iLen                '// 配列要素数
    Dim arEdit()            '// 編集後の配列
    Dim iEdit               '// 編集後配列のインデックス
    Dim flg     As Boolean  '// 重複有無判定フラグ(True:重複あり、False:なし)
    
    ReDim arEdit(0)
    iLen = UBound(ar)
    
    '// 配列ループ
    For i = 0 To iLen
        '// 重複有無判定フラグを重複なしとして初期化
        flg = False
        
        '// 重複除去済みの編集後配列ループ
        For iEdit = 0 To UBound(arEdit)
            '// 編集後配列に格納済みの場合
            If (ar(i) = arEdit(iEdit)) Then
                flg = True
                Exit For
            End If
        Next
        
        '// 現ループの値には重複がない場合
        If (flg = False) Then
            '// 重複がない値のみを編集後配列に格納する
            arEdit(UBound(arEdit)) = ar(i)
            ReDim Preserve arEdit(UBound(arEdit) + 1)
        End If
    Next
    
    '// 配列に格納済みの場合
    If (IsEmpty(arEdit(0)) = False) Then
        '// 余分な領域を削除
        ReDim Preserve arEdit(UBound(arEdit) - 1)
    End If
    
    '// 引数に編集後配列を設定
    ar = arEdit
End Sub

 

Excelの重複の削除機能を使う方法

Excelの重複の削除機能を使う場合、先にも書きましたが処理の実体はセルを扱うRangeオブジェクトのRemoveDuplicatesメソッドです。

重複の削除機能は、対象のセル範囲の中で重複があれば削除して再表示する、という動きになります。

そのため、除去する前のデータをワークシートのセルに設定しておくことが前提になります。

そのため制約事項として、シートの最大行数(Excel 2007以降は1048576行)を超えるデータ数の場合は扱えないことになるため、セルへのデータ貼り付け時にエラーになるため処理しないようにしています。

配列データを貼り付けるシートをどうやって用意するか、という問題がありますが、ここではワークブックに新規シートを追加して、処理が終わったら追加したシートを削除する、という処理にしています。

セルに値を入力することになるため、セルの表示形式によって値が変わらないように表示形式を「文字列」にしてから配列の値をセルに設定しています。

配列データをセルに設定後にRemoveDuplicatesメソッドを使って重複を除去します。

あとは、配列をRedimで重複除去後の要素数で再構築しなおして、セルの値を再度配列に設定しなおしています。

Sub DeleteSameValue3(ar())
    Dim sName       '// 新規シート名
    Dim iLen        '// 配列要素数
    Dim i           '// ループカウンタ
    
    iLen = UBound(ar) + 1
    If (iLen > Rows.Count) Then
        Debug.Print "配列要素数が多すぎます" & iLen
        Exit Sub
    End If
    
    '// 新規シート追加
    ActiveWorkbook.Worksheets.Add
    '// 追加シートの名前を保持
    sName = ActiveSheet.Name
    
    '// セルの表示形式を文字列に設定
    Range(Cells(1, 1), Cells(iLen, 1)).NumberFormat = "@"
    
    '// シートに配列データを貼り付け
    Range(Cells(1, 1), Cells(iLen, 1)).Value = WorksheetFunction.Transpose(ar)
    '// 重複を削除
    Call Range(Cells(1, 1), Cells(iLen, 1)).RemoveDuplicates(Columns:=1, Header:=xlNo)
    
    '// 重複削除後のセル入力範囲の行数を配列の要素数として配列を再構築する
    iLen = ActiveSheet.UsedRange.Rows.Count
    ReDim ar(iLen - 1)
    
    '// 配列にセル値を設定
    For i = 0 To iLen - 1
        '// セルの表示値を配列に設定
        ar(i) = Cells(i + 1, 1).Text
    Next
    
    '// シート削除時の確認ダイアログを非表示化
    Application.DisplayAlerts = False
    
    '// 処理が終わったため追加シートを削除
    Worksheets(sName).Delete
End Sub

次のコードはDeleteSameValue3関数を呼び出すテスト用関数です。

Sub DeleteSameValue3Test()
    Dim ar()
    
    ar = Array(3, 1, 2, 3, 1, 1)
    
    Call DeleteSameValue3(ar)
    
    Dim s
    For Each s In ar
        Debug.Print s
    Next
End Sub

実行結果
3
1
2

]]>
VBAのDictionaryの使い方(全メソッドとプロパティ網羅) https://vbabeginner.net/dictionary-all-method-property/ Thu, 06 Sep 2018 18:15:05 +0000 https://vbabeginner.net/?p=3500 Dictionaryオブジェクトとは

Dictionaryはとても高速に動作するため大量のデータを使う場合には有用な手段の1つになります。

Dictionaryオブジェクトはキーと値で1セットとなるデータ形式を持ちます。他の言語であれば連想配列やハッシュマップなどの言い方をされます。

キーは値を検索するために使う「しおり」の役割を持ちます。食券式の店の場合、食券を買って料理を受けとりますが、このときの食券がキーで、料理が値になります。

同じDictionaryオブジェクトの中でキーと値のセットは複数持つことも可能ですが、同じキーの重複は出来ません。

以下のようなデータ構造になります。

キー
1 111
2 222
3 333
“1” “111”
“2” “222”
“a” “aaaaa”
“b” “bbbb”
“c” “ccc”

 

事前準備

Dictionaryオブジェクトを利用するには2通りの方法があります。1つはCreateObject関数を使う方法で、もう1つは参照設定を行う方法です。どちらでも動作は変わりませんが、参照設定を行うと多少高速なこととメソッドやプロパティが入力候補で表示されます。

個人的には参照設定で利用することをお勧めします。

CreateObject関数を使う方法

書き方は以下のようになります。

Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")

参照設定を行う方法

VBA画面のツールメニュー→参照設定を選び、参照設定ダイアログで「Microsoft Scripting Runtime」にチェックを付けます。

コードの書き方は以下のようになります。

Dim dic As Dictionary
Set dic = New Dictionary

なお、1行で書いても構いません。

Dim dic As New Dictionary

厳密には1行で書かない方がいいのですが、普通に利用する分では問題は発生しませんので1行でも構いません。私自身も1行で書くことが多いです。

このことについての詳細は「VBAでクラス変数の宣言とNewを1行で書いてよいか」をご参照ください。

メソッドとプロパティ

Dictionaryオブジェクトには以下のメソッドとプロパティがあります。使い方は後述のサンプルコードに書いています。

それぞれの引数の「key」はキー、「Item」は値を指します。

メソッド

Sub Add(Key, Item) 新しいキーと値のセットを追加します。

既に追加されているキーの上書きはエラーになります。

Function Exists(Key) As Boolean 指定したキーが含まれているか確認します。

含まれていればTrue、そうでなければFalseを返します。

Function Items() Dictionaryオブジェクトに含まれる全ての値を配列で返します。

Dictionaryオブジェクトはキーの重複は認められませんが、値の重複はありえるため、Itemsメソッドで取得した配列内で値が重複していることはありえますしエラーにもなりません。

Function Keys() Dictionaryオブジェクトに含まれる全てのキーを配列で返します。
Sub Remove(Key) 指定したキーの要素を削除します。
Sub RemoveAll() Dictionaryオブジェクトに含まれる全ての要素を削除します。

プロパティ

Property CompareMode As CompareMethod キーのあいまい検索を許可するかどうかをCompareMethod列挙型の定数で指定します。

Itemプロパティなどで使うキーがDictionaryオブジェクトに格納されているキーと厳密に同じでなければならない場合はBinaryCompareを指定し、大文字・小文字、ひらがな・カタカナ、全角・半角の区別せずに行う場合はTextCompareを指定します。

あくまでも検索する際のキーの条件のため、テキスト比較を設定してもキーの重複が許されるわけではありません。

Dictionaryオブジェクトにデータがセットされている状態ではエラーになります。

CompareMethod列挙型

定数 内容
BinaryCompare 0 バイナリ比較(大文字・小文字、ひらがな・カタカナ、全角・半角を区別します)
TextCompare 1 テキスト比較(大文字・小文字、ひらがな・カタカナ、全角・半角を区別しません)
Property Count As Long キーと値のセットの数を返します。
Property Item(Key) 指定したキーに対応する値の設定および取得を行います。
Property Key(Key) キーを別のキーに変更します。

たとえばキー”1″を”2″に変更したい場合は「Dictionary.Key(“1”) = “2”」のように記述します。

 

一般的な使い方のサンプル

Dictionaryクラスの全てのメソッドとプロパティを使ったサンプルです。

Dictionaryクラスの各メソッドやプロパティには書き方が分かりにくいものもありますので、不明なものはコードをご参考ください。

Sub DictionarySample()
    Dim dic As New Dictionary
    Dim arKeys
    Dim arItems
    Dim vKey
    Dim vItem
    Dim bExist  As Boolean
    
    '// あいまい検索を許可(Addされてないときに行う)
    dic.CompareMode = TextCompare
    
    '// 追加
    Call dic.Add(1, "1")
    Call dic.Add(2, "2")
    Call dic.Add(3, "3")
    Call dic.Add("aaa", Timer)
    
    '// 値の変更
    dic.Item(1) = "111"     '// キー1の値を"1"から"111"に変更
    
    '// キーの変更
    dic.key(2) = 20         '// キーを2から20に変更
    
    '// キーの削除
    Call dic.Remove(3)
    
    '// データ数
    Debug.Print "Count=" & dic.Count
    
    '// 全キー取得
    arKeys = dic.Keys
    '// 全キーを1つずつループ
    For Each vKey In arKeys
        Debug.Print "Item=" & dic.Item(vKey)
    Next
    
    '// 全ての値を取得
    arItems = dic.Items
    '// 全ての値を1つずつループ
    For Each vItem In arItems
        Debug.Print "Item=" & vItem
    Next
    
    '// キー存在チェック
    bExist = dic.Exists(1)
    If (bExist = True) Then
        Debug.Print "キーがあります"
    Else
        Debug.Print "キーがありません"
    End If
    
    '// あいまい検索(CompareMode = TextCompareの確認)
    Debug.Print dic.Item("AAA")     '// Timer値を出力
    Debug.Print dic.Item("aaa")  '// Timer値を出力
    Debug.Print dic.Item("AAA")  '// Timer値を出力
    
    '// 全キー削除
    Call dic.RemoveAll
    
    '// 削除後のデータ数
    Debug.Print "Count=" & dic.Count
End Sub

 

配列よりDictionaryクラスを使う利点

Dictionaryクラスとよく比較対象とされるのが配列です。Dictionaryと配列との違いは、キーがあるかないかですが、それによりデータの格納方式にも違いがあります。配列は先頭から順にデータが並んだ状態でデータを格納しますが、Dictionaryにはデータの並び順は持っておらず、あくまでもキーが基準になります。そのため、並び順が重要な意味を持つ場合には後述するキーのソートを行うか、もしくは、Dictionaryクラスよりも配列を利用した方がよい場合があります。

また、配列はデータを格納するための領域をRedim構文やRedim Preserve構文で確保する必要がありますが、Dictionaryにはその必要がありません。Addメソッドを実行すると領域が拡張されてキーと値が追加されます。

Dictionaryは配列と違ってキーでデータを特定できるため、高速にデータの選別が可能であるという特性があります。そのため、多数のデータの中から特定のデータを抽出する、という処理を行う場合は配列よりも圧倒的にDictionaryクラスを使った方が高速に処理できます

もし配列でのデータ抽出を繰り返し行うような処理で遅いと感じることがあるのであれば「VBAで配列を連想配列Dictionaryに変換する」をご参照ください。

キーと値に登録できるデータの種類

Dictionaryを使う際に、キーにとして扱うデータは数値や文字列が多いと思いますが、オブジェクトを指定することが可能で、値にはオブジェクト(例:Range(“A1”))の他にも配列や戻り値を返す関数(例:Timer)などを指定することができます。ただし、キーに配列をセットすることは出来ません。

オブジェクトをキーに設定できるため、以下のように、キーにRangeオブジェクト、値にワークシートや配列をセットすることが出来ます。

また、キーに使う数値と文字列は別物として扱われます。以下のコードにもありますが、1と”1″は重複せずにどちらもキーとして設定されます。

Sub DictionaryAddTest()
    Dim dic As Dictionary
    Dim ar()
    
    Set dic = New Dictionary
    ReDim ar(3)
    ar(0) = "1"
    ar(1) = "2"
    ar(2) = "3"
    ar(3) = "4"
    
    Call dic.Add("1", "222")
    Call dic.Add(1, 222)
    Call dic.Add(Range("A1"), ActiveSheet)
    Call dic.Add(4, ar)
    Call dic.Add(5, Timer)
End Sub

 

未登録のキーだけを追加したい場合

Dictionaryオブジェクトに未登録のキーだけを追加したい場合は、事前にExistsメソッドで対象のキーが追加済みかどうかを判定した上で、未追加であれば追加するようにします。

以下のような感じになります。

Sub DictionaryExistTest()
    Dim dic As New Dictionary
        
    '// 追加
    Call dic.Add(1, "1")
            
    '// 存在チェック
    If (dic.Exists(2) = False) Then
        Call dic.Add(2, "2")
    End If
End Sub

 

キーの上書きをしたい場合

追加済みのキーに対してAddメソッドを実行するとエラーになります。他の言語のハッシュマップなどではAddメソッドのような追加メソッドで直接上書きが出来るものもありますが、VBAのDictionaryクラスではそれは出来ません。そこでVBAでは疑似的に別の方法で上書きを行うことになります。

上書きの方法には2通りあります。Itemプロパティを使って値の書き換えを行う方法と、Removeメソッドで削除してからAddメソッドで追加する方法です。どちらの方法でも構いませんがItemプロパティでの書き換えの方が手間が少ない分、処理速度も速いです。

以下のコード内でそれぞれの方法を紹介します。

Sub DictionaryOverwriteTest()
    Dim dic As New Dictionary
    
    '// 追加
    Call dic.Add(1, "1")
    Call dic.Add(2, "2")
    
    '// Itemプロパティで書き換え
    dic.Item(1) = "111" '// "1"から"111"に書き換え
    
    '// Remove + Addで書き換え
    dic.Remove (2)
    Call dic.Add(2, "222")
End Sub

 

関数の引数でDictionaryクラスを使う場合

Dictionaryオブジェクトを関数の引数としてやり取りを行う場合に、渡した関数側での処理が呼び出し元にも反映されます。

Integer等の数値型やStringの文字列型の場合は関数の引数にByVal指定をすると呼び出し元には関数内の編集が引き継がれませんが、DictionaryはByValを付けていても渡した関数での編集内容が呼び出し元にも反映されます。

以下のサンプルは呼び出し元で1と2を追加し、関数を呼び出してその関数内部で3を追加し、呼び出し元でDictionaryの全てのキーに対応する値を出力しています。

出力すると呼び出し先の関数で追加された3も一緒に出力され、関数間で引き継がれていることが分かります。

Sub DictionaryCallTest()
    Dim dic As New Dictionary
    Dim vKey
    
    '// 追加
    Call dic.Add(1, "1")
    Call dic.Add(2, "2")
    
    '// 関数呼び出し
    Call DictionaryCalledTest(dic)
    
    '// 確認
    For Each vKey In dic.Keys
        Debug.Print dic.Item(vKey)  '// "1" "2" "3"の3つが出力される
    Next
End Sub

Sub DictionaryCalledTest(a_dic As Dictionary)
    '// 追加
    Call a_dic.Add(3, "3")
End Sub

 

全キーをソートする方法

Dictionaryクラスのキーはソートの仕組みがありません。ただ、場合によってはキーがソートされていた方が都合がいい場合があります。そのままではソートはできませんので、Keysプロパティで全てのキーを配列として取得して、その全キー配列をソートする方法を行います。

ソートの方法にはいくつかあります。

よく紹介されるソート方法はワークシートの指定セル範囲を並べるSortメソッドを使う方法だと思いますが、個人的にはこの方法は避けた方がよいと思っています。理由は、ソートのためにワークシートやセルを用意しなければならず、使ったあとに削除も必要になりますし、セルへの値の設定や操作は処理が遅いため、せっかくのDictionaryクラスを使っている高速性の利点が犠牲になってしまうためです。

そこで、高速にソートを行うためには2通りの方法があります。1つはソート処理を自分で実装する方法で、もう1つは.NETのArrayListクラスのSortメソッドを利用する方法です。どちらを使ってもいいのですが、.NETの利用はあまりメジャーな方法ではないため、ここではクイックソートを実装する方法を紹介します。

クイックソートについての詳細は「VBAの配列をクイックソートで並べ替え」ご参照ください。ここでは利用しませんがArrayListクラスのSortメソッドについては「VBAの配列を.NETのArrayListのSortで並べ替え」をご参照ください。

コードで使っているクイックソートの関数は上記リンク先のコードをそのまま使っています。

実行すると、クイックソート後は”8″ “9” “10”の順になります。

Sub DictionarySort_Quicksort()
    Dim dic As New Dictionary
    Dim vKey
    Dim arKeys()
    
    Call dic.Add(10, "10")
    Call dic.Add(9, "9")
    Call dic.Add(8, "8")

    arKeys = dic.Keys
    
    '// クイックソート前の配列arKeysで確認
    For Each vKey In arKeys
        Debug.Print dic.Item(vKey)
    Next

    '// クイックソート
    Call quicksort(arKeys)
    
    '// クイックソート後の配列arKeysで確認
    For Each vKey In arKeys
        Debug.Print dic.Item(vKey)
    Next
End Sub

'// クイックソート
Sub quicksort(a_Ar(), Optional iFirst As Integer = 0, Optional iLast As Integer = -1)
    Dim iLeft                   As Integer      '// 左ループカウンタ
    Dim iRight                  As Integer      '// 右ループカウンタ
    Dim sMedian                                 '// 中央値
    Dim tmp                                     '// 配列移動用バッファ
    
    '// ソート終了位置省略時は配列要素数を設定
    If (iLast = -1) Then
        iLast = UBound(a_Ar)
    End If
    
    '// 中央値を取得
    sMedian = a_Ar(Int((iFirst + iLast) / 2))
    
    iLeft = iFirst
    iRight = iLast
    
    Do
        '// 中央値の左側をループ
        Do
            '// 配列の左側から中央値より大きい値を探す
            If (a_Ar(iLeft) >= sMedian) Then
                Exit Do
            End If
            
            '// 左側を1つ右にずらす
            iLeft = iLeft + 1
        Loop
        
        '// 中央値の右側をループ
        Do
            '// 配列の右側から中央値より大きい値を探す
            If (sMedian >= a_Ar(iRight)) Then
                Exit Do
            End If
            
            '// 右側を1つ左にずらす
            iRight = iRight - 1
        Loop
        
        '// 左側の方が大きければここで処理終了
        If (iLeft >= iRight) Then
            Exit Do
        End If
        
        '// 右側の方が大きい場合は、左右を入れ替える
        tmp = a_Ar(iLeft)
        a_Ar(iLeft) = a_Ar(iRight)
        a_Ar(iRight) = tmp
        
        '// 左側を1つ右にずらす
        iLeft = iLeft + 1
        '// 右側を1つ左にずらす
        iRight = iRight - 1
    Loop
    
    '// 中央値の左側を再帰でクイックソート
    If (iFirst < iLeft - 1) Then
        Call quicksort(a_Ar, iFirst, iLeft - 1)
    End If
    
    '// 中央値の右側を再帰でクイックソート
    If (iRight + 1 < iLast) Then
        Call quicksort(a_Ar, iRight + 1, iLast)
    End If
    
End Sub

]]>
配列を別の配列にコピーする https://vbabeginner.net/copy-an-array-to-another-array/ Sat, 14 Oct 2017 17:35:59 +0000 http://vbabeginner.net/?p=1632 配列のコピーはコピー先が動的配列であれば代入が可能

配列には2種類あります。配列の要素数を事前に指定する静的配列と、処理中に要素数が変わる動的配列です。

コピー先の配列が静的配列か動的配列かでコピーの仕方は異なります。

コピー先が静的配列の場合は各要素をループで設定しなければなりません。

コピー先が動的配列の場合は各要素をループで設定できますが、代入による設定も可能です。

なお、VBAの場合は値渡しでのコピーになります。参照渡しではありません。関数でByRefの参照渡しにしていても代入時には値渡しで設定されます。

注意点

先にも書きましたが、配列のコピーを代入で行う場合、コピー先の配列はar()のように要素数を設定しない動的配列にしなければなりません。

私が実際にコードを書く場合は動的配列での代入を行うことがほとんどです。理由はラクだからです。

よほどの場合でない限り、コピー先を静的配列にしなければならないことはないと思いますので、通常は動的配列を利用して代入でのコピーで問題ないと思います。

数値配列の代入コピー

Variant型のar1という要素数が4の静的配列とar2という動的配列を用意し、ar1の各要素に数値または文字列が設定されたあとでar2に代入でコピーしてその内容をイミディエイトウインドウに出力しています。

Variant型のため暗黙の型変換を行っているためエラーは発生せず正常に処理されます。

Sub ListCopy()
    Dim ar1(3)
    Dim ar2()
    Dim i
    
    ar1(0) = 0
    ar1(1) = 1
    ar1(2) = "2"
    ar1(3) = "3"
    
    '// 配列の代入
    ar2 = ar1
    
    For i = 0 To UBound(ar2)
        Debug.Print ar2(i)
    Next
End Sub

実行結果
0
1
2
3

Object型変数やユーザー定義型配列の代入コピー

Object型の変数をコピーする場合も代入で行います。

ここではセルを示すオブジェクト型であるRangeクラスオブジェクトを利用しています。コードには書いていませんがユーザー定義型の配列もオブジェクト変数と同様の書き方が可能です。

オブジェクト型のため各要素にセットする場合はSetステートメントが必要ですが、先のコードと同様に配列のコピーは代入で行います。

ミスしやすいのは代入の部分ではなく、オブジェクト型へのコピーのSetの付け忘れの方が多いかもしれませんね。

Sub ListCopyObject()
    Dim ar1(3)  As Range
    Dim ar2()   As Range
    Dim i
    
    Set ar1(0) = Range("A1")
    Set ar1(1) = Range("A2")
    Set ar1(2) = Range("A3")
    Set ar1(3) = Range("A4")
    
    '// 配列の代入
    ar2 = ar1
    
    For i = 0 To UBound(ar2)
        Debug.Print ar2(i).Address(False, False)
    Next
End Sub

実行結果
A1
A2
A3
A4

静的配列のコピー(ループでの各要素のコピー)

コピー先を要素数を指定している静的配列にする場合は代入でのコピーが出来ません。

そのためループによる設定を行うことになります。

Sub StaticListCopy()
    Dim ar1(3)
    Dim ar2(3)
    Dim i
    
    ar1(0) = 0
    ar1(1) = 1
    ar1(2) = "2"
    ar1(3) = "3"
    
    '// 配列のコピーを要素ごとに行う
    For i = 0 To UBound(ar1)
        ar2(i) = ar1(i)
    Next
    
    For i = 0 To UBound(ar2)
        Debug.Print "[" & ar2(i) & "]"
    Next
End Sub

実行結果
0
1
2
3

]]>
VBAで配列を連想配列Dictionaryに変換する https://vbabeginner.net/convert-array-to-associative-array-dictionary/ Sat, 22 Jul 2017 17:20:35 +0000 http://vbabeginner.net/?p=620 配列の検索は遅い

ソートされていない配列から指定文字列を検索するには先頭もしくは最後から検索する必要があります。

この処理は線形探索のため、配列の要素数に比例して計算量が増えていきます。

そのため、配列サイズが大きければ大きいほど、処理が遅くなる欠点があります。

検索回数が2回以上なら連想配列に変換する

配列の先頭から指定文字列を検索する方法を別ページ「VBAで配列に指定文字列が存在する位置を調べる」で書いていますが、上記の理由で処理速度が遅いという弱点があります。もし同じ配列を何度も検索するのであれば、ハッシュを利用した方が検索は劇的に速くなります

ハッシュの利用にはVBA標準のCollectionクラスと、Microsoft Scripting RuntimeのDictionaryクラスの2つが有名ですが、ここではDictionaryクラスを利用します。Dictionaryクラスを利用する理由は、DictionaryクラスのExistsメソッドに該当する機能がCollectionクラスに無いなど、使い勝手の差があるためです。

このページでは配列からDictionaryへの変換に特化して書いていますので、Dictionaryクラスの詳細については「VBAのDictionaryの使い方(全メソッドとプロパティ網羅)」をご参照ください。

配列をDictionaryに変換するソースコード

以下のソースコードは参照設定でMicrosoft Scripting Runtimeにチェックを付けておく必要があります。

コード説明は後述しています。

Sub convArrayToMap(ary(), map As Dictionary)
    Dim iLen    '// 配列要素数
    Dim i       '// ループカウンタ
    
    '// 配列でない場合は処理を抜ける
    If IsArray(ary) = False Then
        Exit Sub
    End If
    
    '// 配列要素数を取得
    iLen = UBound(ary)
    
    '// 配列全ループ
    For i = 0 To iLen
        '// keyにループカウンタ文字列、valueに配列値を設定
        Call map.Add(ary(i), CStr(i))
    Next
End Sub

 

ソースコードの説明

引数の条件

引数aryは呼び出し元で配列として初期化されている必要があります。

引数mapは呼び出し元でNewされている必要があります。

処理説明

処理の概要は、一次元配列の内容を配列の先頭から引数のDictionaryに格納します。格納の際に、keyにループカウンタを設定し、valueに配列値を設定しています。keyに配列値を入れていない理由は、Dictionaryクラスはkeyは重複を許可しないため、配列値が重複している場合を考慮しています。

もちろん、配列値の重複がないことが確定している場合はkey=配列値としても問題ありません。このあたりは要件によって変わってくるため適宜検討が必要になる部分です。

使い方

利用例

Sub convArrayToMapTest()
    Dim ary()                       '// 配列
    Dim map     As New Dictionary   '// Dictionaryクラスオブジェクト
    Dim i, k                        '// ループカウンタ
    Dim tmStart As Double           '// 計測開始時間
    Dim tmEnd   As Double           '// 計測終了時間
    Dim tmDiff  As Double           '// 計測経過時間
    Dim s                           '// Dictionaryのvalue
    
    '// 動的配列を作成。先頭から"10000"から"0"までを設定。
    ReDim ary(10000)
    For i = 0 To 10000
        ary(i) = CStr(10000 - i)
    Next
    
    '// 配列をDictionaryに変換
    tmStart = Timer
    Call convArrayToMap(ary, map)
    tmEnd = Timer
    tmDiff = tmEnd - tmStart
    Debug.Print "Dictionary変換に掛かる時間:" & tmDiff & "秒"
    
    '// 配列で指定文字列"8"を検索した場合を計測(配列の先頭から9992番目を検索)
    tmStart = Timer
    For i = 0 To 10000
        For k = 0 To 10000
            If ("8" = ary(k)) Then
                '// この時点の変数kの値が検索文字列がある配列の位置になる
                Exit For
            End If
        Next
    Next
    tmEnd = Timer
    tmDiff = tmEnd - tmStart
    Debug.Print "配列での検索経過時間:" & tmDiff & "秒"
    
    '// Dictionaryから指定文字列"8"を検索
    tmStart = Timer
    For i = 0 To 10000
        If (map.Exists("8") = True) Then
            s = map.Item("8")
        End If
    Next
    tmEnd = Timer
    tmDiff = tmEnd - tmStart
    Debug.Print "Dictionaryでの検索経過時間:" & tmDiff & "秒"
End Sub

利用例の説明

11行目から14行目で動的配列を用意し、18行目でそれをDictionaryに変換しています。

28行目では検索一致としてループを抜けています。この時点での変数kの値が指定文字列が格納されている配列のインデックスになります。

40行目で検索文字列の存在チェックを行い、存在する場合は検索文字列をキーとして元配列のインデックスを取得しています。

他は全て処理計測用のコードです。Dictionary変換、配列検索、Dictionary検索、のそれぞれで処理時間を計測しています。私の環境では以下のように経過時間が出力されました。

Dictionary変換に掛かる時間:0.029296875秒
配列での検索経過時間:6.720703125秒
Dictionaryでの検索経過時間:0.01953125秒

検索1万回を配列で行った場合は6.72秒、Dictionaryは0.019秒です。

約340倍もの圧倒的な差があります。検索を1回しか行わないのが確実であれば、配列で線形探索を行ってもいいのですが、そうでないのであれば速度が安定して高速なDictionaryに変換した方がいいです。

]]>
VBAで2次元配列の初期化と利用方法 https://vbabeginner.net/initialization-and-usage-of-2d-array/ Thu, 20 Jul 2017 18:22:29 +0000 http://vbabeginner.net/?p=607 VBAは多次元配列の利用が可能

VBAの配列では2次元の作成が可能です。また、3次元、4次元、と多次元配列も可能です。実際には2次元までが現実的なところと思われます。

3次元以降になってくると管理もデバッグも大変になってくるため、コレクションなどの配列以外の方法で実装する方が都合がいい気がします。

実装可能な最大次元数は要素数が2(ary(1, 1, ・・・)と、各要素を1で定義する配列)の場合は理論上は31次元になりますが、メモリの関係で16次元ぐらいが最大次元数になります。

これについては別ページ「VBAで定義可能な配列の最大次元数」に書いています。

2次元配列の宣言

2次元配列とは行と列の関係にある配列です。

実際に利用する場面としては、Excelのシートの内容を保持するために、行と列からセルを特定する場合が多いと思われます。

宣言の書き方

'// Dim 変数名(要素1番目, 要素2番目) As データ型
Dim a(2, 3) As String  '// 3行4列の2次元配列

2次元配列に限らず、配列を定義する場合の要素数は実際の領域から1引いた値を設定します。

要素に2と書くと、0, 1, 2 の3つの領域を持つことになります。

なお、Option Baseを設定している場合は異なります。

2次元配列へのデータの設定

以下のような感じでデータを格納します。

Sub 二次元配列()
    Dim ary(1, 2)
    
    ary(0, 0) = "00"
    ary(0, 1) = "01"
    ary(0, 2) = "02"
    ary(1, 0) = "10"
    ary(1, 1) = "11"
    ary(1, 2) = "12"
End Sub

 

2次元配列の初期化

2次元配列の初期化は1次元配列と同様でEraseステートメントを使います。

静的配列の場合はEraseステートメントを実行すると配列自体は残りますが値が変数の型に合わせて初期化されます。

動的配列の場合は配列であることは残りますが、要素数が未定の状態にまで解放され、Dim ary() の状態になります。

Erase ary

 

シートの内容を2次元配列に格納するサンプル

以下のような表形式のデータを2次元配列に格納するサンプルです。

ソースコード

事前に表の行数と列数が確定している場合のコードです。

静的配列で書いています。

Sub GetSheetData2Dim()
    Dim ary(4, 4)       '// シートの内容を格納する2次元配列
    Dim sCell           '// セル値
    Dim iRow            '// 行
    Dim iCol            '// 列
    Dim iRowMax         '// 最大行
    Dim iColMax         '// 最大列
    
    '// 最終行を取得
    iRowMax = ActiveSheet.UsedRange.Rows.Count - 1
    iColMax = ActiveSheet.UsedRange.Columns.Count

    '// 処理開始セルを選択
    Range("A2").Select
    
    '// 行ループ
    For iRow = 0 To iRowMax - 1
        '// 列ループ
        For iCol = 0 To iColMax - 1
            '// 現在行列のセル値を首都kう
            sCell = ActiveCell.Offset(iRow, iCol).Value
            '// 2次元配列にセル値を格納
            ary(iRow, iCol) = sCell
        Next
    Next
End Sub

ソースコードの説明

2行目で2次元配列を静的配列として定義しています。

10行目は表の行数を取得しています。ヘッダ行があるためその分を減らしています。

11行目は表の列数を取得しています。最終行と最終列の取得については別ページ「VBAで編集されているセル範囲を選択する(最終行、最終列の取得)」にも書いてありますので参考にしてください。

14行目で開始セル位置を選択しています。これ以降はこのセルが基点となります。

17行目で行のループを行い、その中の19行目で列のループを行います。

21行目で現在の行と列のセルの値を取得します。

23行目で取得したセルの値を配列に格納します。

]]>