えくせるちゅんちゅん

ことりがエクセルをちゅんちゅんするブログ

トップ > Excel > Excelシートのデータ範囲を2次元配列に格納するVBA汎用関数を作ってみた Part2

Excelシートのデータ範囲を2次元配列に格納するVBA汎用関数を作ってみた Part2

Excel VBA VBA汎用関数

Excelシートのデータ範囲を2次元配列に格納する汎用関数を修正したので紹介します。

f:id:Kotori-ChunChun:20190614230310p:plain

はじめに

本記事は、下記の記事の続編です。

www.excel-chunchun.com


公開後、以下のような指摘を頂きました。

（ブログに書くと、こうやって指摘してもらえるので、本当に助かります。）


m氏

ワークシート（+α） → Range Range → 2次元配列 の2つの関数に分離して ReadCell はその2つを組み合わせたシンタックスシュガーにした方が汎用的に思えるのですがいかがでしょうか？

関数を分離すると、メモリやCPUを消費するロジックしか思いつかなかったので妥協したのです。

結論を書いておきますと、良い方法が思いつかないので今回は見送りました。

無理に分割できないこともないですが、それほどメリットが見込めなかったので保留とします。


H氏

findを使うと、

・非表示セルは検索可

・オートフィルタによる非表示セルは検索不可

完全に見落としてました。

参考にした記事 でもはっきりと「フィルタをかけている：含まない」とありました。

そうなると、如何にして最終行・最終列を求めるかが腕の見せ所ですね！

今回はこちらの問題について対策を考えてみました。



Findの挙動について調べてみた

まず、Findはオートフィルタで非表示になっているセルが無視されてしまう、という事は確認できました。

そこまでは知られている事実なので、いまさら証明しなくても良いと思います。


そこで気になったのが、末尾の空白行はどうなるのかという点。

  • 一応データは隠れている部分に存在するので、E5になるのか。（Select出来なくて仕方なく直前のセルを返すイメージ）

  • それとも可視データの末尾であるE3になるのか。（探索すらしていないイメージ）

検証データ

分かりづらいですが、1～5行目が表示状態。6～7行目がフィルタで非表示状態です。

A B C D E
1 データ データ データ データ データ
2 データ データ データ データ データ
3 データ データ データ データ データ
4
5
6 非表示 非表示 非表示 非表示 非表示
7 非表示 非表示 非表示 非表示 非表示データ

検証結果

E3

というわけで、6,7行目は「存在しない」ものとして扱われていることが分かりました。


もう一つ気になったのが、「フィルタされた行を横断した場合に検索順序はどうなっているのか」という点。

問題の式

WS.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column

は、最終列(右端)で右下→右上、1列左に移動して下→上、1列左に移動して...という順で検索しますが、Rangeの性質を鑑みるにフィルタすると挙動が変わる可能性を考えました。


検証結果

結論としては、挙動が変わります。

文章で説明しても分かりづらいので図にしました。


まず、通常時の挙動ですが、xlByColumns, xlPreviousという指示に従いこのような順番で検索しています。

f:id:Kotori-ChunChun:20190616141806p:plain


次にフィルタ中の挙動ですが、このように非表示の部分で領域が分割されて検索されているような動きをしました。

f:id:Kotori-ChunChun:20190616141808p:plain


もともとRangeオブジェクトは、複数の領域を一度に保持することのできる特殊な概念で出来ているオブジェクトです。

本件ではRange("A1:E10")が、Range("A1:E5,A9:E10")に変化してからFindで検索がされているのでしょう。

仮に内部の動きをVBAで表現するとしたらこんな感じですね。

'Rangeの順番を逆順に出力
Function Preview_RangeAddress_Prev()
    
    Dim rngArea As Range
    Set rngArea = Range("A1:E10").SpecialCells(xlCellTypeVisible)
    
    Dim rng As Range, col As Range, row As Range
    Dim i As Long, j As Long, k As Long
    
    For k = rngArea.Areas.Count To 1 Step -1
        Set rng = rngArea.Areas(k)
        
        For j = rng.Columns.Count To 1 Step -1
            Set col = rng.Columns(j)
            
            For i = col.Rows.Count To 1 Step -1
                Set row = col.Rows(i)
                Debug.Print row.Address(False, False)
            Next
        Next
    Next
    
End Function


対策を考えてみる

Findが使えないということはよく分かりましたので、フィルタ中に最終行・最終列を求めるには、どんな方法で探索するのが良いかなーと考えてみました。

頑張ってググったら何か出てきそうな気がしますが、FindとEndの勢力が強すぎて中々ヒットしない予感がするので、自力で考えることにしました。

他に良さそうなアイディアがあれば是非教えてください！


For For Ifでガリガリ探索

この方法は、セルに一つづつアクセスしているため、探索対象のセル数が増えれば増えるほど低速になる危険性があります。

かと言ってUsedRange全体を2次元配列に取り込むと、2次元配列に取り込む範囲を最小限にしたいのに「鶏が先か、卵が先か問題」が発生してしまいます。

すでに指摘されているように、メモリさえ大丈夫なら、2次元配列に取り込んでから、指定領域だけを抽出した2次元配列を再構築すればもう少し高速に処理できるかもしれません。

'直接セルにアクセスしてガリガリ検索
Function GetFinalRowCol_RangeFull(WS As Worksheet) As Long()

    ReDim ret(1 To 2) As Long
    Dim i As Long, j As Long
    
    With WS.UsedRange
        '最終行：Cellsは第一引数しか指定しない場合、コレクションのように動作する。
        For i = .Count To 1 Step -1
            If Not IsEmpty(.Cells(i).Value) Then
                ret(1) = .Cells(i).Row
                Exit For
            End If
        Next
        '最終列
        For j = .Columns.Count To 1 Step -1
            For i = .Rows.Count To 1 Step -1
                If Not IsEmpty(.Cells(i, j).Value) Then
                    '=j は 先頭列からデータが始まらない時に間違い
                    ret(2) = .Cells(1, j).Column
                    GoTo ExitForCol
                End If
            Next
        Next
ExitForCol:
    End With
    
    GetFinalRowCol_RangeFull = ret()
End Function


CountAで探索

VBAには2次元配列を処理する便利な関数が無いのですが、いくつかの処理はExcelの関数を呼び出すことで代用できます。

ExcelのCOUNTA関数を使って、データが入っているか否かを行単位、列単位で一括で算出するようにしてみました。

たぶんコレが最有力候補でしょう。

'ret(1)=最終行 ret(2)=最終列を求める
Function GetFinalRowCol_CountA(WS As Worksheet) As Long()

    ReDim ret(1 To 2) As Long
    Dim i As Long, j As Long
    
    With WS.UsedRange
    
        Dim items(1 To 2) As Variant
        Set items(1) = .Rows
        Set items(2) = .Columns
        
        'CountAで行毎、列毎に検索
        For j = 1 To 2
            For i = items(j).Count To 1 Step -1
                If WorksheetFunction.CountA(items(j)(i)) > 0 Then
                    ret(j) = i
                    Exit For
                End If
            Next
        Next
        
        '開始位置加算
        If ret(1) > 0 Then ret(1) = ret(1) + .Row - 1
        If ret(2) > 0 Then ret(2) = ret(2) + .Column - 1
        
    End With
    
    GetFinalRowCol_CountA = ret()
    
End Function


計測結果

それぞれの手法を千回～一万回繰り返して速度を計測したら、ちょっと思いがけない結果になりました。

前回の記事ではUsedRangeとCellsはUsedRangeのほうが高速と書きましたが、巨大なデータではCellsのほうが圧倒的に高速でした。

また、10000x20以上のデータにおいては、どの手法も同等という結果でした。

そしてデータが大きくなるほど、Cells.Findが圧倒的に優位になる。という思わぬ結果になりました。

Cells.Findはデータ量に関係なく一定の処理速度になりそうな気配ですね。

しかし下記の時間は千回、万回繰り返した結果であり、全データを読み込む処理を何度も繰り返すことはないハズなので、速度面についてはそこまで意識しなくても良いような気がします。

Findはフィルタされている部分を読み込めないという問題があり、フィルタの付け直しの動作が保証できない以上、CountAやガチでループさせてチェックさせるのが一番無難ではないかと考えます。

ç»å



完成版

ソースコード

CountAを使った手法を、前回の関数に組み込んでこのようにしました。

Option Explicit

'API
#If VBA7 Then
    Private Declare PtrSafe Function SafeArrayAllocDescriptor Lib "oleaut32" ( _
            ByVal cDims As Long, _
            ByRef ppsaOut() As Any _
        ) As Long
#Else
    Private Declare Function SafeArrayAllocDescriptor Lib "oleaut32" ( _
            ByVal cDims As Long, _
            ByRef ppsaOut() As Any _
        ) As Long
#End If

'Variant型二次元配列
Property Get EmptyVariantArray2() As Variant()
    Dim res As Long
    res = SafeArrayAllocDescriptor(2, EmptyVariantArray2)
    If res <> 0 Then Err.Raise 9999
End Property

'シート内のセルデータ読み込み必ず二次元配列を返す
' StartRow : 読み込み開始行(1~)
' StartCol : 読み込み開始列(1~)
' ExceptRow   : 読み込み除外行(0~) 末端から任意の行数消す
' ExceptCol   : 読み込み除外列(0~) 末端から任意の列数消す
Public Function ReadCell(ByVal WS As Worksheet, _
                            Optional ByVal StartRow As Long = 1, _
                            Optional ByVal StartCol As Long = 1, _
                            Optional ByVal ExceptRow As Long = 0, _
                            Optional ByVal ExceptCol As Long = 0) As Variant

    '最終行列 = 領域の末尾からデータの存在するセルを検索
    Dim FinalRow As Long, FinalCol As Long, FinalRowCol() As Long
    FinalRowCol = GetFinalRowCol(WS)
    FinalRow = FinalRowCol(1)
    FinalCol = FinalRowCol(2)
    
    '出力行列 = 最終 - 開始 + 1 - 除外
    Dim OutRow As Long, OutCol As Long
    OutRow = FinalRow - StartRow + 1 - ExceptRow
    OutCol = FinalCol - StartCol + 1 - ExceptCol
    
    '該当セル無し:-1,-1を返す
    If OutRow <= 0 Or OutCol <= 0 Then
        
        ReadCell = EmptyVariantArray2()
        
    '該当セルが単一セル:2次元配列として返す
    ElseIf OutRow = 1 And OutCol = 1 Then
    
        ReDim RetVal(1 To 1, 1 To 1)
        RetVal(1, 1) = WS.Cells(StartRow, StartCol).Value
        ReadCell = RetVal
    
    '通常の範囲データ
    Else
    
        ReadCell = WS.Cells(StartRow, StartCol).Resize(OutRow, OutCol).Value
        
    End If
    
End Function

'ret(1)=最終行 ret(2)=最終列を求める
Public Function GetFinalRowCol(ByVal WS As Worksheet) As Long()

    ReDim ret(1 To 2) As Long
    Dim i As Long, j As Long
    
    With WS.UsedRange
    
        Dim items(1 To 2) As Variant
        Set items(1) = .Rows
        Set items(2) = .Columns
        
        'CountAで行毎、列毎に検索
        For j = 1 To 2
            For i = items(j).Count To 1 Step -1
                If WorksheetFunction.CountA(items(j)(i)) > 0 Then
                    ret(j) = i
                    Exit For
                End If
            Next
        Next
        
        '開始位置加算
        If ret(1) > 0 Then ret(1) = ret(1) + .row - 1
        If ret(2) > 0 Then ret(2) = ret(2) + .Column - 1
        
    End With
    
    GetFinalRowCol = ret()
    
End Function

Sub Test_ReadCell()
    Dim V As Variant
    V = ReadCell(ActiveSheet)
    Debug.Print UBound(V, 1), UBound(V, 2)
    ActiveSheet.Cells(1, 1).Resize(UBound(V, 1), UBound(V, 2)).Select
    Stop    
End Sub


補足

  • 関数の戻り値をReDim ret(1 To 2) As Longとしているのは私の好みです。（Uboundの次元数も1～nなので0 To 1より1 To 2のほうがわかりやすいと思います）
  • 今回も動作テストはまだこれからなのでなんとも言えません。


蛇足

フィルタを解除してからFindで探索

ここまで試したものの、フィルタが邪魔をするならばフィルタを解除すれば良いじゃないか！という事に気が付きました。

フィルタしたまま色々な処理を行うのはバグの元となるので、ある意味これが最適解かもしれません。

（特に致命的なものとして、２次元配列の書き出し時にバグります。）


ただし、フィルタを復元するのはデータが大きいとフィルタの再適用で、かなりの負荷が掛かりそうな気がします。

フィルタの復元まで考慮しないほうが良いのではないか、という気がします。

フィルタを復元するコードは、検索したら素晴らしいコードが出てきたので、こちらのクラスを使わせていただきます。

'clsFilterReconstructure コンストラクタ
Function FilterReconstructure(WS As Worksheet) As clsFilterReconstructure

    'オートフィルタの状態を取得・再現するオブジェクト
    Dim oFtrRcn As New clsFilterReconstructure
    
    ' init にオートフィルタがあるかもしれないシートを渡す
    Call oFtrRcn.init(WS)
    
    ' フィルタ条件の記憶
    Call oFtrRcn.StoreCriterias
    
    Set FilterReconstructure = oFtrRcn
    
End Function

'UsedRangeから逆順Find
Function GetFinalRowCol_UsedRangeFind_Filter(WS As Worksheet) As Long()

    ReDim ret(1 To 2) As Long
    
    With FilterReconstructure(WS)
        
        .ShowAllData
        
        With WS.UsedRange
            ret(1) = .Find("*", , xlFormulas, , xlByRows, xlPrevious).row
            ret(2) = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
        End With
        
        .ReConstructFilter
        
    End With
    
    GetFinalRowCol_UsedRangeFind_Filter = ret()
    
End Function


おわりに

今回は前の続きで

「Excelシートのデータ範囲を2次元配列に格納する汎用関数」

を作ってみました。


シート全体を2次元配列に取り込んで、処理をして、結果を書き出す。という流れはExcel VBAを使う上で最も重要な高速化方法です。

簡単な処理の場合は、この関数を使えば手軽に高速化できるので大変便利でしょう。

しかし、読み込んだデータの利用方法によっては、クラス化したりDictionaryにしたほうが便利な場面もあります。

ちょっとした処理なら、前ページのマイルールの書き方で十分に事足ります。

うまく使い分けていきましょう。


以上

続編

今回作成したReadCell関数で「非表示のセルを除外する（可視セルだけを二次元配列に格納する）」ことが出来るオプションを付け足しました。

もしよろしければこちらもご覧ください。

www.excel-chunchun.com

何か御座いましたらコメント欄、またはTwitterからどうぞ♪

それではまた来週♪　ちゅんちゅん(・8・)