社内SEになったのでVBAでExcelのテーブルを操作したい!

テーブルの特定の行のRowオブジェクトを取り出す

吾輩は猫である。名前はまだない。どこで生れたか頓と見当がつかぬ。何でも薄暗いじめじめした所でニャーニャー泣いていた事だけは記憶している。


' テーブルのある列で特定の値に一致する行の他の列を参照するRangeオブジェクトを取得a
Public Function getRangeObjOfListObjects( _
        sheetName As String, tableName As String, searchColumn As String, searchValue As String, columnItem As String) As Range
    Dim index As Integer
    Dim columnIndex As Integer
    Dim ws As Worksheet
    Dim rng As Range
    
    index = -1
    columnIndex = -1
    Set ws = ThisWorkbook.Worksheets(sheetName)
    
    ' テーブルの特定の列で値の一致する行のインデックス
    Set rng = ws.ListObjects(tableName).ListColumns(searchColumn).DataBodyRange
    index = rng.Find(What:=searchValue, LookIn:=xlValues, LookAt:=xlWhole).Row
    
    ' 同じ行で参照したい列のインデックス
    columnIndex = ws.ListObjects(tableName).ListColumns(columnItem).DataBodyRange.Column
    
    Set getRangeObjOfListObjects = ws.Cells(index, columnIndex)
End Function

' getRangeObjOfListObjectsを使い参照したセルの値を表示
Public Sub test()
    Dim sheetName As String
    Dim tableName As String
    Dim searchColumn As String
    Dim searchValue As String
    Dim targetColumn As String
    Dim rng As Range
    
    ' 検索するアイテムを指定
    sheetName = "Sheet1"
    tableName = "テーブル2"
    searchColumn = "列2"
    searchValue = "Value5"
    targetColumn = "列3"
    
    If existTableName(sheetName, tableName) Then
        Set rng = getRangeObjOfListObjects(sheetName, tableName, searchColumn, searchValue, targetColumn)
        MsgBox rng.Value
        Exit Sub
    Else
        MsgBox "テーブルが見つかりませんでした!"
    End If
End Sub

' 指定したテーブルが存在するか確認(True: 存在する, False: 存在しない)
Public Function existTableName(sheetName As String, tableName As String)
    Dim tbl As ListObject
    Dim ws As Worksheet
    Dim res As Boolean
    
    res = False
    Set ws = ThisWorkbook.Worksheets(sheetName)
    
    For Each tbl In ws.ListObjects
        If tbl.Name = tableName Then
            res = True
            Exit For
        End If
    Next tbl
    
    existTableName = res
End Function

コメントを残す