テーブルの特定の行の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