標準のFindNextでは検索できない「取消線の入ったセル」を検索するためのクラスです。「」の部分は簡単にカスタマイズできるので、簡単に任意の条件で検索する機能を作ることができます。
CellFinder
アクティブセルから「前へ」「次へ」を検索するクラスです。FindNext/FindBackに渡すICellFinderクラスで検索条件を判定します。
Option Explicit
Private Enum vbCompareAddress
vbBeforeCell
vbActiveCell
vbAfterCell
End Enum
Private Function FindRange() As Range
If Selection.CountLarge = 1 Or Selection.MergeCells Then
Set FindRange = ActiveSheet.UsedRange
Else
Set FindRange = UsedRangeInSelection
End If
If FindRange Is Nothing Then
Set FindRange = ActiveCell
End If
End Function
Public Function UsedRangeInSelection() As Range
Set UsedRangeInSelection = Intersect(ActiveSheet.UsedRange, Selection)
End Function
Private Function CompareAddress(c As Range) As vbCompareAddress
If ActiveCell.Address = c.Address Then
CompareAddress = vbActiveCell
Else
CompareAddress = IIf(ActiveCell.Row < c.Row Or (ActiveCell.Row = c.Row And ActiveCell.Column < c.Column), vbAfterCell, vbBeforeCell)
End If
End Function
Public Sub FindNext(finder As ICellFinder)
Call FindNext_(finder, vbAfterCell)
Call FindNext_(finder, vbBeforeCell)
Call Find(finder, ActiveCell, vbActiveCell)
finder.NotFound
End Sub
Private Sub FindNext_(finder As ICellFinder, ca As vbCompareAddress)
With FindRange
Dim i As Long
For i = 1 To .CountLarge
Call Find(finder, .Cells(i), ca)
Next
End With
End Sub
Public Sub FindBack(finder As ICellFinder)
Call FindBack_(finder, vbBeforeCell)
Call FindBack_(finder, vbAfterCell)
Call Find(finder, ActiveCell, vbActiveCell)
finder.NotFound
End Sub
Private Sub FindBack_(finder As ICellFinder, ca As vbCompareAddress)
With FindRange
Dim i As Long
For i = .CountLarge To 1 Step -1
Call Find(finder, .Cells(i), ca)
Next
End With
End Sub
Private Sub Find(finder As ICellFinder, c As Range, ca As vbCompareAddress)
If ca = CompareAddress(c) Then
If finder.Find(c) Then
c.Activate
End
End If
End If
End Sub
ICellFinder
検索判定処理のインターフェースクラスです。FindでTrueを返すと検索にヒットしたことになります。
Option Explicit
Public Function Find(c As Range) As Boolean
End Function
Public Sub NotFound()
End Sub
StrikethroughFinder
（ありがちな）取消線書式が設定されたセルを判定するクラスです。Findの引数cがチェック対象のセルで、取消線書式が付いていたらTrueを、なければFalseを返します。
Option Explicit
Implements ICellFinder
Public Function ICellFinder_Find(c As Range) As Boolean
If Not IsNull(c.Font.Strikethrough) Then
ICellFinder_Find = c.Font.Strikethrough
Exit Function
End If
Dim i As Long
For i = 1 To Len(c.Value)
If c.Characters(Start:=i, Length:=1).Font.Strikethrough Then
ICellFinder_Find = True
Exit Function
End If
Next
ICellFinder_Find = False
End Function
Public Sub ICellFinder_NotFound()
MsgBox "取消線は見つかりませんでした"
End Sub
使い方
標準モジュールでショートカットキーを割り当てます。このサンプルでは、F3キーで「次へ」Shift+F3キーで「前へ」取消線書式を含むセルを検索しています。つまりCellFinderをベースとして、ICellFinderを実装したクラスを用意するだけで、好みの検索機能を追加できるようになります！
Private finder As New CellFinder
Private ifinder As New StrikethroughFinder
Sub Auto_Open()
Application.OnKey "{F3}", "FindNext"
Application.OnKey "+{F3}", "FindBack"
End Sub
Sub FindNext()
finder.FindNext ifinder
End Sub
Sub FindBack()
finder.FindBack ifinder
End Sub
最後に
もう3年も前の投稿とのことですが、これを読んで、いまさらながら触発されまして、過去に作った機能をリファクタリングしてみて、この日記をつけました。投稿した方、ありがとうございました！
qiita.com
