テーブルごとに1つのマクロを独立して使用する

Question

ゴール

セル値に基づいてテーブルに対してオートフィルタを実行するボタン。

通報

シートを複製、マクロが原稿上の表を参照します。

現在のコード

Sub Macro1() 
    ActiveSheet.ListObjects("Table33").Range.AutoFilter Field:=6, Criteria1:=">" & Range("K9").Value 
End Sub 

相対的な方法でテーブルを割り当てる方法はありますか？表は常にシートごとに同じセルに表示されます。

Answer 1

私はあなたのために3つの例があります。最初に指定したセルのテーブルが見つかります。この場合、TableName = ActiveSheet.Range("D6").ListObject.NameのD6をテーブル内のセルに変更する必要があります。テーブルを見つけたら、そのテーブルでフィルタを実行します。 3つの例はすべて、表が見つからない場合にメッセージ・ボックスをスローします。コメントできない場合は削除してください。ボタンを3のいずれかにつなぎ、それを使用することができます。

テーブルhereを見つけるコードを見つけ、提供されたコードで動作するように修正しました。

Sub RangeTable() 

Dim TableName As String 
Dim ActiveTable As ListObject 

'Determine if ActiveCell is inside a Table 
    On Error GoTo NoTableSelected 
    TableName = ActiveSheet.Range("D6").ListObject.Name 'Change range to cell inside of table 
    Set ActiveTable = ActiveSheet.ListObjects(TableName) 
    On Error GoTo 0 

'Do something with your table variable (ie Add a row to the bottom of the ActiveTable) 
    ActiveTable.Range.AutoFilter Field:=6, Criteria1:=">" & Range("K9").Value 

Exit Sub 

'Error Handling 
NoTableSelected: 
    MsgBox "There is no Table currently selected!", vbCritical 

End Sub 

以下のコードは、現在選択しているセルを見て、それに関連付けられたテーブルを検索し、そのテーブルを使用してフィルタを実行します。

Sub ActiveTable() 

Dim SelectedCell As Range 
Dim TableName As String 
Dim ActiveTable As ListObject 

Set SelectedCell = ActiveCell 

'Determine if ActiveCell is inside a Table 
    On Error GoTo NoTableSelected 
    TableName = SelectedCell.ListObject.Name 
    Set ActiveTable = ActiveSheet.ListObjects(TableName) 
    On Error GoTo 0 

'Do something with your table variable (ie Add a row to the bottom of the ActiveTable) 
    ActiveTable.Range.AutoFilter Field:=6, Criteria1:=">" & Range("K9").Value 

Exit Sub 

'Error Handling 
NoTableSelected: 
    MsgBox "There is no Table currently selected!", vbCritical 

End Sub 

別の方法としては、ちょうどあなただけの、これは正常に動作する必要があります一つのテーブルを持っているので、もしActiveSheetで見つかった最初のテーブルの上にフィルタを実行し、それ以下のコードです。これを使用すると、実行する前にテーブル内のセルを選択する必要はありませんが、1つのシートに複数のテーブルがある場合は、上記のコードを使用することができます。

Sub SheetTable() 

Dim TableName As String 
Dim ActiveTable As ListObject 

'Determine if ActiveCell is inside a Table 
    On Error GoTo NoTableSelected 
    TableName = ActiveSheet.ListObjects.Item(1) 
    Set ActiveTable = ActiveSheet.ListObjects(TableName) 
    On Error GoTo 0 

'Do something with your table variable (ie Add a row to the bottom of the ActiveTable) 
    ActiveTable.Range.AutoFilter Field:=6, Criteria1:=">" & Range("K9").Value 

Exit Sub 

'Error Handling 
NoTableSelected: 
    MsgBox "There is no Table currently selected!", vbCritical 

End Sub