0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

第12回 直感!スグに使える業務向けVBA汎用プロシージャ(データ範囲の自動検知)

Last updated at Posted at 2025-06-20

私が編纂・配布させていただいているVBA汎用プロシージャの紹介と簡単な解説になります。
以下のリンクから .bas ファイルをダウンロードできます(zipファイル)

今回紹介するプロシージャは

プロシージャ名 概要
ShowAllCells 対象シートの全行・前列を表示
AutoCellToArray 対象シートのセルの内容を自動で配列に変換

の2つになります。今回紹介するプロシージャは第3回で紹介したCellToArrayの発展版に当たります、もちろん状況に応じて使い分けしていただくものにはなりますがとにかくこれを思いついたときはアドレナリンがめっちゃ流れましたね(笑)
そんな私にとって思い入れのあるプロシージャになっております。

まずはそのサポート用プロシージャとなるShowAllCellsについて紹介させていただきます。

ShowAllCells

Sub ShowAllCells(Optional targetSheet As Worksheet)
'------------------------------------------------------------------------------------------------------------------------------
' 概要  |対象シートの全行・全列を再表示し、オートフィルターも解除する
'------------------------------------------------------------------------------------------------------------------------------
' 引数1 |targetText - 対象文字列(String型)
'------------------------------------------------------------------------------------------------------------------------------
' 実装  |Ver.1.1.0(2025/06/14:新規)
'------------------------------------------------------------------------------------------------------------------------------
    
    If targetSheet Is Nothing Then Set targetSheet = ActiveSheet
    
    With targetSheet
        '通常非表示の解除
        .Cells.EntireRow.Hidden = False
        .Cells.EntireColumn.Hidden = False
    
        'フィルター解除
        If .FilterMode Then
            .ShowAllData
        End If
    End With
    
End Sub

セルの非表示をオンにしていると最終行番号などが正確に取得できないためそれらをすべてオフにするためのプロシージャとなっております。もし見た目を元のままにしたい場合は目的の処理終了後個別にVBAで設定が可能です。本題とはずれてしまうので割愛させていただきますが、ChatGPT等に聞いていただければそこまで大変な作業ではありません。

AutoCellToArray

さて、こちらがメインディッシュです!
CellToArrayでは配列に格納するセル範囲を指定しておりましたが、AutoCellToArrayではセル範囲を指定せずシート上のデータが存在する範囲を自動で検知しすべて配列に格納します。

Function AutoCellToArray(Optional targetSheet As Worksheet) As Variant
'------------------------------------------------------------------------------------------------------------------------------
' 概要  |データが格納されたセル範囲を自動検知し内容を2次元配列として抽出
'------------------------------------------------------------------------------------------------------------------------------
' 引数1 |targetSheet - 対象のワークシートオブジェクト(規定値:ActiveSheet)(Worksheet型)
'------------------------------------------------------------------------------------------------------------------------------
' 戻り値 |Variant型 - 指定範囲セルの内容を抽出した2次元配列(インデックスは1開始)
'------------------------------------------------------------------------------------------------------------------------------
' 実装  |Ver.1.1.0(2025/06/14:新規)
'------------------------------------------------------------------------------------------------------------------------------
    
    Dim vLoop       As Long '行ループカウンタ
    Dim hLoop       As Long '列ループカウンタ
    Dim getVarEnd   As Long '最終行番号の取得
    Dim getHorEnd   As Long '最終列番号の取得
    Dim startVar    As Long '配列格納開始行番号
    Dim startHor    As Long '配列格納終了行番号
    Dim endVar      As Long '配列格納開始列番号
    Dim endHor      As Long '配列格納終了列番号
    Dim varMax      As Long '最大最終行番号記憶
    Dim customArr   As Variant '格納用配列
    
    If targetSheet Is Nothing Then Set targetSheet = ActiveSheet
    
    'データテーブルの開始・終了列番号の取得
    For hLoop = targetSheet.Columns.Count To 1 Step -1
        getVarEnd = Cells(targetSheet.Rows.Count, hLoop).End(xlUp).Row
        If getVarEnd = 1 And targetSheet.Cells(1, hLoop) = "" Then getVarEnd = 0
        If getVarEnd > 0 And endHor = 0 Then endHor = hLoop
        If getVarEnd > 0 And endHor <> 0 Then startHor = hLoop
        If getVarEnd > varMax Then varMax = getVarEnd
    Next hLoop
    
    'データテーブルの開始・終了行番号の取得
    For vLoop = varMax To 1 Step -1
        getHorEnd = Cells(vLoop, targetSheet.Columns.Count).End(xlToLeft).Column
        If getHorEnd = 1 And targetSheet.Cells(vLoop, 1) = "" Then getHorEnd = 0
        If getHorEnd > 0 And endVar = 0 Then endVar = vLoop
        If getHorEnd > 0 And endVar <> 0 Then startVar = vLoop
    Next vLoop
    
    '配列の初期化
    ReDim customArr(endVar - startVar + 1, endHor - startHor + 1)
    
    'セル内容の抽出
    For vLoop = 1 To endVar - startVar + 1
        For hLoop = 1 To endHor - startHor + 1
            customArr(vLoop, hLoop) = targetSheet.Cells(vLoop + startVar - 1, hLoop + startHor - 1)
        Next hLoop
    Next vLoop
    
    AutoCellToArray = customArr
    
End Function

例えば
Excel-12-1.png

このような表があったときに

call AutoCellToArray(Sheet1)

または

call AutoCellToArray

Excel-12-2.png

赤枠部の範囲を並列に格納してくれます。
もちろん既存のCellToArrayと目的によって使い分けていただく必要がありますが、直感的にシステムを構築できるようにするための選択肢が広がったかと思います!

直感!VBAシリーズ記事一覧

もしよろしければ他の記事もご覧ください!

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?