えくせるちゅんちゅん

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

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

今回は以前作成したセル範囲を二次元配列化する関数を改造して、非表示のセルを除外するようにしてみたので紹介します。

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


きっかけ

先日Infomentさんのこんな記事を読みました。

infoment.hatenablog.com

非表示セルの除外かー。そういえば地味に使いそうな気がするなー。


というわけで、先日書いた二次元配列化の記事

www.excel-chunchun.com

を改造することにしました。


ところが、これ意外と面倒くさい。

長くなってきたので、順番に整理して記事にすることにしました。


検証

複数セル範囲を二次元配列の二次元配列に格納する

「二次元配列の二次元配列」と言われても分かりづらいので、まずはこちらの図をご覧頂きたい。

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

これは、領域A1:F6をグレーの領域で分割して、各領域をValuesという二次元配列の変数に格納したものである。

つまり、領域の位置で示す二次元配列の中に、セルの位置で示す二次元配列を入れるという、ジャグ配列である。

まずはこれを作成する関数を作成した。


ワークシート上のセルはこのような状態で、灰色の部分は非表示になっているものとする。

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

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


セル範囲A1:F6から、可視領域A1:B2D1:F2A5:B6D5:F6を取り出したいならば、SpecialCells(xlCellTypeVisible)を使えば良い。

Sub Test1()
    Debug.Print ActiveSheet.Range("A1:F6").SpecialCells(xlCellTypeVisible).Address(False, False)
End Sub

結果

A1:B2,D1:F2,A5:B6,D5:F6


上記の領域からValueプロパティを使ってVariant変数に格納してみる。

Sub Test2_1()
    Dim v As Variant
    v = ActiveSheet.Range("A1:F6").SpecialCells(xlCellTypeVisible).Value
End Sub

結果

実際には先頭の領域A1:B2のデータしか読み込まれない。

v Variant/Variant(1 to 2,1 to 2)
v(1) Variant(1 to 2)
v(1,1) A1 Variant/String
v(1,2) B1 Variant/String
v(2) Variant(1 to 2)
v(2,1) A2 Variant/String
v(2,2) B2 Variant/String

複数セル範囲(領域)はAreasプロパティで指定する必要がある。

n Range.Areas(n).Address
1 A1:B2
2 D1:F2
3 A5:B6
4 D5:F6

つまり、ValueAreas(1)が省略されているものとして、処理されていたのである。

この書き方を続けるのは冗長なので、ActiveSheet.Range("A1:F6").SpecialCells(xlCellTypeVisible).Areasを変数化しておく。

いつもなら変数名を型名と同じ名前にはしないが、今回はプロパティ名がAreasなので特例として認めることにした。

Sub Test2_2()
    Dim Areas As Areas
    Set Areas = ActiveSheet.Range("A1:F6").SpecialCells(xlCellTypeVisible).Areas
    
    Dim v As Variant
    v = Areas(1).Value
End Sub


つまり、A1:B2,D1:F2,A5:B6,D5:F6をそれぞれ変数に格納するなら、それぞれの領域に対してValueを代入すれば良いのである。

Sub Test3_1()
    Dim Areas As Areas
    Set Areas = ActiveSheet.Range("A1:F6").SpecialCells(xlCellTypeVisible).Areas
    
    Dim v1, v2, v3, v4
    v1 = Areas(1).Value
    v2 = Areas(2).Value
    v3 = Areas(3).Value
    v4 = Areas(4).Value
End Sub

領域の順番はセルの順番と同じで、左上から右へ。そして次の行の左端から右へと流れていく。

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

それを踏まえて、3_1を二次元配列に格納するならこうなる。

Sub Test3_2()
    Dim Areas As Areas
    Set Areas = ActiveSheet.Range("A1:F6").SpecialCells(xlCellTypeVisible).Areas
    
    Dim Values(1 To 2, 1 To 2) As Variant
    Values(1, 1) = Areas(1).Value
    Values(1, 2) = Areas(2).Value
    Values(2, 1) = Areas(3).Value
    Values(2, 2) = Areas(4).Value
End Sub

結果

この結果こそが最初の図であり、ローカルウィンドウの様子をあわせると次のようになる。

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


動的な二次元配列の二次元配列に格納する

先の方法では縦横2x2の領域にしか対応できないので、領域の縦横の個数を算出する必要がある。

RangeならColumns.CountRows.Countを使うが、Areasにはそれがない。

じゃあどうすれば良いのかというと、冗長だがRowプロパティの一致する数を数えるしかない。

Dim AreasRowsCount As Long, AreasColsCount As Long
Dim lastRow As Long

'列数
AreasColsCount = 0: lastRow = Areas(1).Row
For Each area In Areas
If area.item(1, 1).Row <> lastRow Then Exit For
    AreasColsCount = AreasColsCount + 1
    lastRow = area.item(1, 1).Row
Next

'行数
AreasRowsCount = Areas.Count / AreasColsCount

二次元配列Values(行,列)の要素だが、ここでは「領域行番号」と「領域列番号」と呼ぶことにする。

さらに、Areas.Countに相当する行×列の値を「総領域数」と呼ぶことにする。

領域列番号は、最初の領域の先頭セルの行Areas(1).Rowを保持しておき、一致している間カウントすることで求める。

領域行番号は、総領域数Areas.Countを領域の列数で割ることで求める。

そもそも、ここで言うAreasは行・列の表示・非表示によって領域を分割したので必ずきれいに割り切れるので、この方法で問題ない。


次に二次元配列Cells.Valueを二次元配列Valuesに格納する部分だが、ここでもColumns.Countなどが使えないのが障害となる。

実はExcel VBAを書いていると頻繁に一次元の連番を二次元の座標に変換することがあるが、もっとも完結に書けるのが以下の方法である。

Dim Values()
ReDim Values(1 To AreasRowsCount, 1 To AreasColsCount)

Dim i As Long
For i = 0 To Areas.Count - 1
    Values(1 + (i \ AreasColsCount), _
        1 + (i Mod AreasColsCount)) = Areas(1 + i).Value
Next

上記のうち、

'Areasの巡回
For i = 0 To Areas.Count - 1
・・・ = Areas(1 + i).Value
 
'領域行番号
1 + (i \ AreasColsCount)

'領域列番号
1 + (i Mod AreasColsCount)

という部分が注目どころ。

今回は何番目の領域かを把握する必要があるため、For EachよりForが適していた。

しかし領域行番号や領域列番号を求めるには、開始値0としたほうが簡潔になるため、そのようにFor文を書いた。

分かりやすいように各変数の値を表にしてみる。

i Areas(1+i) 1 + (i \ AreasColsCount) 1 + (i Mod AreasColsCount)
0 1 1 1
1 2 1 2
2 3 2 1
3 4 2 2

あまり見かけない演算子を使っているので、数式について補足する。

  • バックスラッシュA \ Bは、AをBで割って整数部分だけを求める
  • A Mod Bは、AをBで割ったときの余りを求める

計算式を可視化してみよう。

i Areas(1+i) 1 + (i \ AreasColsCount) 1 + (i Mod AreasColsCount)
0 1 1 = (1 + (0 \ 2)) 1 = (1 + (0 Mod 2))
1 2 1 = (1 + (1 \ 2)) 2= (1 + (1 Mod 2))
2 3 2 = (1 + (2 \ 2)) 1 = (1 + (2 Mod 2))
3 4 2 = (1 + (3 \ 2)) 2= (1 + (3 Mod 2))

このようにして、Values(1 To AreasRowsCount, 1 To AreasColsCount)に適したインデックスが生成された。

Excel VBAで多くの開始インデックスを原則1としている私だが、こういう計算のときだけは0を採用している。

無理に1を使うと、式が複雑化して解読困難になるので、勇気ある人は一度試してみたほうが良い。

私は両方を経験した上で、0がベストだという結論を出した。


単なる二次元配列に変換する

Values(,)は「二次元配列の二次元配列」であり、前回作成したReadCell関数の戻り値の仕様と合致しない。

どうにかして二次元配列の二次元配列を、単なる二次元配列にマージしなければならない。

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

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


VBAにはそんな都合の良い関数は用意されていないため、面倒ではあるがストレートに代入していくのが無難だろう。

長いのでソースコードは省略して、合成後のソースコードの中に記載する。


完成品

ここまでの流れのプログラムをつなぎ合わせたのが以下のソースコードである。

'えくせるちゅんちゅん
'
'2019/6/14
'Excelシートのデータ範囲を2次元配列に格納するVBA汎用関数を作ってみた Part1
'https://www.excel-chunchun.com/entry/readcellvalue
'
'2019/6/16
'Excelシートのデータ範囲を2次元配列に格納するVBA汎用関数を作ってみた Part2
'https://www.excel-chunchun.com/entry/readcellvalue2
'
'2019/7/28
'Excelシートのデータ範囲を2次元配列に格納するVBA汎用関数を作ってみた Part3
'https://www.excel-chunchun.com/entry/readcellvalue3
'
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~) 末端から任意の列数消す
' IncludeHidden : 非表示セルを含めるか否か
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, _
                            Optional ByVal IncludeHidden As Boolean = True) 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 = Array() '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
    
        If IncludeHidden Then
            ReadCell = ReadCell_JagArray(WS.Cells(StartRow, StartCol).Resize(OutRow, OutCol))
            ReadCell = MergeJagArray2(ReadCell)
        Else
            ReadCell = WS.Cells(StartRow, StartCol).Resize(OutRow, OutCol).Value
        End If
        
    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

'戻り値:Values(rowArea,colArea)(rowCell,colCell)
'RangeをAreaに分割して二次元配列の二次元配列データとして返却
Function ReadCell_JagArray(readRange As Range) As Variant

    Dim arr As Variant
    Dim area As Range
    Dim Areas As Areas
    Set Areas = readRange.SpecialCells(xlCellTypeVisible).Areas
    
    Dim AreasRowsCount As Long, AreasColsCount As Long
    Dim lastRow As Long
    
    AreasColsCount = 0: lastRow = Areas(1).Row
    For Each area In Areas
        If area.item(1, 1).Row <> lastRow Then Exit For
        AreasColsCount = AreasColsCount + 1
        lastRow = area.item(1, 1).Row
    Next
    AreasRowsCount = Areas.Count / AreasColsCount
    
    Debug.Print AreasRowsCount, AreasColsCount
    
    Dim Values()
    ReDim Values(1 To AreasRowsCount, 1 To AreasColsCount)
    
    Dim i As Long
    For i = 0 To Areas.Count - 1
        Values(1 + (i \ AreasColsCount), _
                1 + (i Mod AreasColsCount)) = Areas(1 + i).Value
'        Debug.Print 1 + i, 1 + (i \ AreasColsCount), 1 + (i Mod AreasColsCount)
    Next
    
    ReadCell_JagArray = Values
End Function

'二次元配列の二次元配列を、二次元配列にマージする
'尚、サイズの不一致のエラー処理は行っていない。
'Cells.Valueに準拠し内側二次元配列の要素の開始インデックスは1固定とする。
Function MergeJagArray2(JagArray As Variant)
    Dim i As Long, j As Long
    Dim retArray As Variant
    
    '行数と列数の合計
    Dim sumRow As Long, sumCol As Long
    For i = LBound(JagArray, 1) To UBound(JagArray, 1)
        sumRow = sumRow + UBound(JagArray(i, 1), 1)
    Next
    For j = LBound(JagArray, 2) To UBound(JagArray, 2)
        sumCol = sumCol + UBound(JagArray(1, j), 2)
    Next
    
    '配列のマージ
    Dim idxRow As Long, idxCol As Long
    ReDim retArray(1 To sumRow, 1 To sumCol)
    
    idxRow = 0
    For i = 1 To UBound(JagArray, 1)
        idxCol = 0
        For j = 1 To UBound(JagArray, 2)
            Call PasteArray2Array2(retArray, JagArray(i, j), idxRow, idxCol)
            idxCol = idxCol + UBound(JagArray(i, j), 2)
        Next
        idxRow = idxRow + UBound(JagArray(i, 1), 1)
    Next
    
    MergeJagArray2 = retArray
End Function

'二次元配列を二次元配列の任意の座標に転写するs
'offsetRow,offsetCol : 出力先オフセット位置。標準0,0
Sub PasteArray2Array2(ByRef baseArray, ByRef newArray, offsetRow As Long, offsetCol As Long)
    Dim i As Long, j As Long
    For i = 1 To UBound(newArray, 1)
        For j = 1 To UBound(newArray, 2)
            baseArray(offsetRow + i, offsetCol + j) = newArray(i, j)
        Next
    Next
End Sub

テスト用

Sub Test_ReadCell2()
    Dim v As Variant
    v = ReadCell(ActiveSheet)
    Stop
End Sub

シートは少なくともこのようにしてからテストすること

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


参考資料

ところで、私は二次元配列ベースで処理を行い、処理速度と消費メモリの削減を優先したためこのようになったが、下記の記事では領域を切らずに一気にやる方法を記載している。

(要改善だが)大抵の場合はこの方法のほうが簡単かつ高速になるのではないかと思った。

kouten0430.hatenablog.com


まとめ

本記事ではセル範囲を非表示セルを考慮して二次元配列化する関数を作成してみた。

いまのところ需要がないので、十分な実地テストが出来ているとは言えないが、もし必要になった時はこれを引っ張り出してきて楽々開発したい。


尚、今回は躊躇なく配列の複写を何度も行っているため、お世辞にも高速とは言えないところがある。

デバッグはもちろん、速度やメモリのチューニングは使う人がなんとかしてほしい。

以上


www.excel-chunchun.com

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

週1回の更新を目指して、頑張ってますので応援よろしくおねがいします!

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