コピペで使えるVBAのコード置き場

Excelのワークシートを読込み配列に格納

いまだにVBAはどう組むのが正解なのかわからない。

ワークシートのデータを読み込んで配列に入れます。

これよく書くので、コピペ用に大枠だけ作りました。

Option Explicit

Dim sh As Worksheet         'ワークシートオブジェクト
Dim dataArray As Variant    'ワークシートから取得したデータ格納用配列

'---------------------------------------------------------------------------------------------------
'
'---------------------------------------------------------------------------------------------------
Private Const SH_NAME As String = "Sheet1"         'ワークシート名
Private Const DATA_START_ADDRESS As String = "C4"  'データ開始アドレス
Private Const DATA_COL_OFFSET As Long = 1          'データ開始アドレスから何列オフセットするか

'---------------------------------------------------------------------------------------------------
' 【関 数 名】execute
' 【処理概要】ワークシート読み込み
' 【引    数】なし
' 【戻 り 値】なし
'---------------------------------------------------------------------------------------------------
Public Sub execute()
'    Call Initialize
    
    'ワークシートオブジェクトを取得する
    Set sh = ThisWorkbook.Worksheets(SH_NAME)
    
    dataArray = LoadWorkSheetToArray
    If IsEmpty(dataArray) Then
        MsgBox ("データを入力してください。")
        GoTo LBL_END
    End If
    
LBL_END:
    Set sh = Nothing
    Call Terminate
End Sub

'---------------------------------------------------------------------------------------------------
' 【関 数 名】LoadWorkSheetToArray
' 【処理概要】
' 【引    数】
' 【戻 り 値】
'---------------------------------------------------------------------------------------------------
Public Function LoadWorkSheetToArray() As Variant
    Dim arr As Variant
    Dim dataRow As Long      'データの基点の行
    Dim dataCol As Long      'データの基点の列
    Dim colOffset As Long    'データの基点の列からのオフセット
    Dim lastRowIndex As Long '行インデックス
    
    'データの基点の行を取得する
    dataRow = sh.Range(DATA_START_ADDRESS).Row

    'データの基点の列を取得する
    dataCol = sh.Range(DATA_START_ADDRESS).Column
    'データの基点の列からのオフセットを取得する
    colOffset = dataCol + DATA_COL_OFFSET
    
    'データの末尾行を取得する
    lastRowIndex = sh.Cells(Rows.Count, dataCol).End(xlUp).Row
    If lastRowIndex <= 1 Then
        Exit Function
    End If
    
    'データを配列に格納する
    arr = sh.Range(sh.Cells(dataRow, dataCol), sh.Cells(lastRowIndex, colOffset))
    
    LoadWorkSheetToArray = arr
End Function

'--------------------------------------------------------------------------------
' 関 数 名:初期処理
' 処理概要:初期設定を行う
' 引   数:なし
' 返 却 値:なし
'--------------------------------------------------------------------------------
Private Sub Initialize()
    'カーソル変更
    Application.Cursor = xlWait
    'ステータスバー
    Application.StatusBar = "処理中......"
    '描画抑止
    Application.ScreenUpdating = False
    '自動計算抑止
    Application.Calculation = xlCalculationManual
End Sub

'--------------------------------------------------------------------------------
' 関 数 名:終期処理
' 処理概要:後始末を行う
' 引   数:なし
' 返 却 値:なし
'--------------------------------------------------------------------------------
Private Sub Terminate()
    '自動計算抑止解除
    Application.Calculation = xlCalculationAutomatic
    '描画抑止解除
    Application.ScreenUpdating = True
    'カーソル変更
    Application.Cursor = xlDefault
    'ステータスバー
    Application.StatusBar = False
End Sub

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です