kurukuru-papaのブログ

主に、ソフトウェア開発に関連したメモを書き溜めたいと思います。

Excelシート上の表形式内容を読み込むためのクラスを作りました

' 表読み込みクラス
'
' 指定されたシートに記述されている表を読むクラスです。
'
' 新規作成:2008/03/16

Option Explicit

Private sheet As Worksheet
Private startCell As Range
Private dataRange As Range

' コンストラクタ
Private Sub Class_Initialize()
End Sub


' 初期化処理
' コンストラクタには引数を渡せないみたいだったので、
' このSubプロシージャを作成しました。
Public Sub Initialize(sheetName As String, startRow As Integer, startColumn As Integer)
    Dim tmpSheet As Worksheet
    Dim endCell As Range
    
    ' シートの存在チェック
    For Each tmpSheet In Worksheets
        If tmpSheet.name = sheetName Then
            Set sheet = tmpSheet
        End If
    Next
    
    ' シートがなければ作成
    If sheet Is Nothing Then
        Worksheets.Add
        ActiveSheet.name = sheetName
        Set sheet = ActiveSheet
    End If
    
    Set startCell = sheet.Cells(startRow, startColumn)
    Set endCell = sheet.Cells(startCell.End(xlDown).row, startCell.End(xlToRight).column)
    Set dataRange = sheet.Range(startCell, endCell)
End Sub

' クリアする
Public Sub Clear()
    ' シートの内容をクリアする
    sheet.Cells.ClearContents
End Sub

' 表から値を取得する。
' rowKey - 行のキー
' columnKey - 列のキー
' return - キーが存在した場合、対応する値を返却。
'          キーが見つからなかった場合、ブランクを返却。
Public Function GetValue(rowKey As String, columnKey As String) As String
    Dim cell As Range
    Set cell = GetCell(rowKey, columnKey)
    If cell Is Nothing Then
        GetValue = ""
    Else
        GetValue = cell.value
    End If
End Function

' 表から指定キーのセルを取得する。
' rowKey - 行のキー
' columnKey - 列のキー
' return - キーが存在した場合、対応する値を返却。
'          キーが見つからなかった場合、Nothingを返却。
Private Function GetCell(rowKey As String, columnKey As String) As Range
    Dim row As Integer
    Dim column As Integer
    Dim cell As Range
    Dim keyBuf As String
    Dim result As Range
    
    ' 対象要素なしの場合の返却値を設定する。
    'GetCell = Nothing
    
    ' 入力チェック
    If rowKey = "" Or columnKey = "" Then
        Exit Function
    End If
    
    ' 行キーに一致する行を検索する
    row = -1
    For Each cell In dataRange.Columns(1).Cells
        If cell.value = rowKey Then
            row = cell.row
            Exit For
        End If
    Next
    If row = -1 Then
        Exit Function
    End If
    
    ' 列キーに一致する列を検索する
    column = -1
    For Each cell In dataRange.Rows(1).Cells
        If cell.value = columnKey Then
            column = cell.column
            Exit For
        End If
    Next
    If column = -1 Then
        Exit Function
    End If
    
    ' 対象要素の値を取得する
    Set GetCell = dataRange.Cells(row, column)
End Function