配列の貼り付け

様々なサイトなどで紹介されているとおり、配列を使った処理はとても高速です。サンプルとして、10000行に入力された数値を日付に変換する時間を計ってみました。

　

↓ セル毎に、一つずつ上書きする場合

Sub Sample1()
    Dim r   As Range    
    ' セル毎に上書き。
    For Each r In Range("A1:A10000")
        r = DateSerial(Left(r, 4), Mid(r, 5, 2), Right(r, 2))
    Next
End Sub

↓ 配列内で置換して、最後にまとめ上書きする場合

Sub Sample2()
    Dim i   As Long
    Dim seq As Variant    
    ' 値を一旦、配列に格納する。
    seq = Range("A1:A10000")    
    ' 配列内で、数値を日付に変換。
    For i = LBound(seq) To UBound(seq)
        seq(i, 1) = DateSerial(Left(seq(i, 1), 4), _
                               Mid(seq(i, 1), 5, 2), _
                               Right(seq(i, 1), 2))
    Next
    ' まとめて上書き。
    Range("A1:A10000") = seq
End Sub

※ なお計測には、こちらのクラスモジュールを使わせていただきました。とても使いやすくて便利です。ありがとうございます。

www.excelspeedup.com

私の端末での結果は、以下の通りです。

• サンプル１　⇒　7.9766秒（セル毎編集パターン）
• サンプル２　⇒　0.1172秒（配列で一括パターン）

処理時間で、68倍も高速という結果が出ました（※端末の性能によります）。

この配列の貼り付けですが、一次配列を縦に貼り付けたいときは、ちょっと面倒です。なぜなら、一次配列は列方向に延びているため、貼り付ける際に縦横を入れ替える必要があるからです。また、範囲を指定するにも手間が掛かります。

↓ こんな感じです。

    Range("A1").Resize(UBound(seq)) = WorksheetFunction.Transpose(seq)

そこで、配列を指定位置に貼り付ける関数を作成してみました。

Function ArrayPaste(PasteRange As Range, PasteArray As Variant) As Integer    
    Dim r       As Long     ' 貼り付ける行数
    Dim C       As Long     ' 貼り付ける列数
    Dim DN      As Integer  ' 配列の次元数    
    ' 配列の次元数取得    
        ArrayPaste = GetArrayDimension(PasteArray)
        If ArrayPaste = -1 Then
            Exit Function
        Else
            DN = ArrayPaste
        End If
    
    ' 貼り付け行数の取得。    
        r = UBound(PasteArray) - LBound(PasteArray) + 1
    
    ' 配列の次元で場合分け。    
        Select Case DN            
        ' 一次配列の場合。        
            Case 1
                PasteRange.Resize(r) = WorksheetFunction.Transpose(PasteArray)                
        ' 二次配列の場合。            
            Case 2
                C = UBound(PasteArray, 2) - LBound(PasteArray, 2) + 1
                PasteRange.Resize(r, C) = PasteArray    
        ' 三次以上の場合。　※未対応。            
            Case Else
                ArrayPaste = -2        
        End Select
End Function

配列の次元数を取得する関数は、こちらです。

Function GetArrayDimension(seq As Variant) As Integer
    Dim i       As Long     ' 繰り返し作業用整数
    Dim temp    As Variant  ' DN取得用一時変数    
    ' 配列か否かの判定。    
        If IsArray(seq) = False Then
            GetArrayDimension = -1
            Exit Function
        End If    
    ' 配列の次元数を取得。    
        On Error Resume Next
        Do While Err.Number = 0
            i = i + 1
            temp = UBound(seq, i)
        Loop        
        GetArrayDimension = i - 1
End Function

↓ 使用例

Sub Sample3()
    ArrayPaste Range("A1"), seq
End Sub

ArrayPaste関数の戻り値は、次の通りです。

• 0の場合：正常終了
• -1の場合：異常終了（配列ではない）
• -2の場合：異常終了（配列の次元数が３以上）

一次配列の場合、Transpose関数で縦横を入れ替えていますが、二次配列ではその必要がありません。従って、まず配列の次元数を確認したうえで、次元数毎に処理する作りになっています。

参考まで。