Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
20200624_確実にWorksheetのAutoFilterオブジェクトを返す関数
Rem --------------------------------------------------------------------------------
Rem
Rem @module kccFuncExcelPartial
Rem
Rem @description Excelオブジェクト操作関数
Rem
Rem @update 2020/06/24
Rem
Rem @author @KotorinChunChun (GitHub / Twitter)
Rem
Rem @license MIT (http://www.opensource.org/licenses/mit-license.php)
Rem
Rem --------------------------------------------------------------------------------
Option Explicit
Rem テーブルではないセルを返す
Rem
Rem @param ws As Worksheet 取得元ワークシート
Rem
Rem @return As Range テーブルではないセル
Rem
Public Function OutsideListObjectRange(ws As Excel.Worksheet) As Excel.Range
'1,1から右下方向に斜めに検索する。16384x16384が全てテーブルだとエラーになる。
' Dim i As Long
' For i = 1 To ws.Columns.Count
' If ws.Cells(i, i).ListObject Is Nothing Then
' Exit For
' End If
' Next
' Set OutsideListObjectRange = ws.Cells(i, i)
'
' '使用済み範囲外 列全体がテーブルの場合はエラーになる。
' With ws.UsedRange
' Set OutsideListObjectRange = ws.Cells(.Rows.Count + 1, .Columns.Count + 1)
'
' '使用済み範囲外 上記に加えてSelectionChangeイベントが起こる
' Set OutsideListObjectRange = ws.Cells.SpecialCells(xlLastCell).Cells(2, 2)
' End With
'最後のセルならテーブルに属する可能性は皆無
Set OutsideListObjectRange = ws.Cells(ws.Rows.Count, ws.Columns.Count)
End Function
Rem 確実にWorksheetのAutoFilterオブジェクトを返す
Rem
Rem @param ws As Worksheet 取得元ワークシート
Rem
Rem @note
Rem 一瞬だけ再表示し選択を切り替えるので副作用に注意が必要
Rem
Public Function WorksheetAutoFilter(ws As Excel.Worksheet) As Excel.AutoFilter
'現状を保持
Dim curAE As Boolean: curAE = Application.EnableEvents
Application.EnableEvents = False
Dim curObj As Object: Set curObj = ActiveWindow.Selection
Dim sheetVisibled: sheetVisibled = ws.Visible
ws.Visible = xlSheetVisible
'AutoFilterを取得 / 選択セルの変更と復旧
ws.Parent.Activate
ws.Select
With ActiveWindow.Selection
OutsideListObjectRange(ws).Select
Set WorksheetAutoFilter = ws.AutoFilter
.Select
End With
'状態を復旧
ws.Visible = sheetVisibled
curObj.Parent.Parent.Activate
curObj.Parent.Activate
curObj.Select
Application.EnableEvents = curAE
End Function
Rem アクティブブックの先頭シートでテストを実行
Private Sub Test_WorksheetAutoFilter()
Debug.Print WorksheetAutoFilter(ActiveWorkbook.Worksheets(1)).Range.Address
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.