今回は以前作成したセル範囲を二次元配列化する関数を改造して、非表示のセルを除外するようにしてみたので紹介します。
きっかけ
先日Infomentさんのこんな記事を読みました。
非表示セルの除外かー。そういえば地味に使いそうな気がするなー。
というわけで、先日書いた二次元配列化の記事
を改造することにしました。
ところが、これ意外と面倒くさい。
長くなってきたので、順番に整理して記事にすることにしました。
検証
複数セル範囲を二次元配列の二次元配列に格納する
「二次元配列の二次元配列」と言われても分かりづらいので、まずはこちらの図をご覧頂きたい。
これは、領域A1:F6をグレーの領域で分割して、各領域をValuesという二次元配列の変数に格納したものである。
つまり、領域の位置で示す二次元配列の中に、セルの位置で示す二次元配列を入れるという、ジャグ配列である。
まずはこれを作成する関数を作成した。
ワークシート上のセルはこのような状態で、灰色の部分は非表示になっているものとする。
↓
セル範囲A1:F6から、可視領域A1:B2、D1:F2、A5:B6、D5: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 |
つまり、ValueはAreas(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
領域の順番はセルの順番と同じで、左上から右へ。そして次の行の左端から右へと流れていく。
それを踏まえて、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
結果
この結果こそが最初の図であり、ローカルウィンドウの様子をあわせると次のようになる。
動的な二次元配列の二次元配列に格納する
先の方法では縦横2x2の領域にしか対応できないので、領域の縦横の個数を算出する必要がある。
RangeならColumns.CountやRows.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)) | ２= (1 + (1 Mod 2)) |
| 2 | 3 | 2 = (1 + (2 \ 2)) | 1 = (1 + (2 Mod 2)) |
| 3 | 4 | 2 = (1 + (3 \ 2)) | ２= (1 + (3 Mod 2)) |
このようにして、Values(1 To AreasRowsCount, 1 To AreasColsCount)に適したインデックスが生成された。
Excel VBAで多くの開始インデックスを原則1としている私だが、こういう計算のときだけは0を採用している。
無理に1を使うと、式が複雑化して解読困難になるので、勇気ある人は一度試してみたほうが良い。
私は両方を経験した上で、0がベストだという結論を出した。
単なる二次元配列に変換する
Values(,)は「二次元配列の二次元配列」であり、前回作成したReadCell関数の戻り値の仕様と合致しない。
どうにかして二次元配列の二次元配列を、単なる二次元配列にマージしなければならない。
↓
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
シートは少なくともこのようにしてからテストすること
参考資料
ところで、私は二次元配列ベースで処理を行い、処理速度と消費メモリの削減を優先したためこのようになったが、下記の記事では領域を切らずに一気にやる方法を記載している。
（要改善だが）大抵の場合はこの方法のほうが簡単かつ高速になるのではないかと思った。
まとめ
本記事ではセル範囲を非表示セルを考慮して二次元配列化する関数を作成してみた。
いまのところ需要がないので、十分な実地テストが出来ているとは言えないが、もし必要になった時はこれを引っ張り出してきて楽々開発したい。
尚、今回は躊躇なく配列の複写を何度も行っているため、お世辞にも高速とは言えないところがある。
デバッグはもちろん、速度やメモリのチューニングは使う人がなんとかしてほしい。
以上
何か御座いましたらコメント欄、またはTwitterからどうぞ♪
それではまた来週♪ ちゅんちゅん(・8・)
