事前にブックを開いているときに、比較したりコピーしたい同名ファイルが別フォルダにあったりすることが良くあります。
でもＥｘｃｅｌは別フォルダであっても同じファイル名のブックを開くことができません。
以下、機能を使えばエクスプローラから簡単に同名ブックを開くことができます。ただし、別名に変更され、読み取り専用になります。

事前にブックを開いておきます。

エクスプローラから「同名ブックを参照用に開く」を選択します。

ブックの先頭に「（参照用）」を追加することによりブック名が被らないようにして、同名ブックを開けるようにしています。

なお、インストールが必要になりますので、通常のアップデートの要領と同様にinstall.vbs を実行してください。
インストール時に以下メッセージが表示されるので「はい」を押下してください。

文字修飾を検索機能に移動しました。(4.23.0)

文字修飾機能に正規表現を追加しようかと思ったのですが、逆に通常の検索機能に追加した方が便利そうなのでこちらに追加しました。
通常の検索ボタンに「修飾」を追加。

セル・シェイプの正規表現検索のタブに「文字修飾」を追加。置換と同じような使い勝手で「文字修飾」が可能になります。
また、検索範囲に「選択範囲」を追加しました。

４月ごろから64bit版でマウスホイールの処理で異常終了していましたが原因が判明し、修正しました。(4.23.2)
ただし、64bit版で非モーダルウィンドウ（セル・シェイプの正規表現検索など）で異常終了する件は変わらず。→動作を停止しています。

今回、マウスホイールの処理を見直すことにより、セル・シェイプの正規表現検索と他の画面を表示した際のマウスホイールの動作が安定します（32bit版)

Excel 方眼紙 の結合セルを自在に修正する。機能を追加しました。→4.24.0
次の動画をご覧ください。

なんとなく、雰囲気はつたわりましたでしょうか？

１つのセルでもよいのですが、この例では複数の結合セルを選択

「結合セルの幅拡張」を実行

選択列の幅を広げ、右側の列をそのまま右にシフトします。

通常であれば、選択したセルと右側のセルの結合を解除してやり直すか、全体を他のシートにコピーし、選択列を含む列を挿入した後、もとに戻すなどかなり面倒な作業になります。
お仕事でやっていた日には心をやられること必然という感じですが、この機能を使えばワンタッチでできるようになります。

この機能はショートカットに割り当てることにより、超ベリーベリー使えるようになります。
おすすめショートカットは

です。なお、以下の結合セルも移動できる以下の機能も割り当てておくと、より美味しく頂けます。

なお、結合セルの操作には、以下の制限があります。

• １行または１列のセルを拡張または１行または１列に縮小した場合に、書式が維持されないことがあります。
• 拡張先が結合セルまたはセルに文字が入っている場合、拡張されません。
• 拡張先に選択されたセルの拡張・縮小を邪魔するセル（がある場合、拡張または縮小できない場合があります。

4.25.0 で文字切れ対策にアクティブセルの印刷プレビューを追加しました。

印刷の際の文字切れ対策にプレビューで確認したりする場合、わりと面倒ですよね。

「ファイル」→「印刷」→「指定のページを入力」→「表示」という手順になります。

この機能を使用すると、アクティブなセルがあるページをプレビューすることができます。
もちろん、キーに割り当てれば、超イージーになりますので使ってください。

掲示板での投稿で、

>Grep結果が現状65530件までしか正常表示されない様なのですが、
>上限なしへの改修ご対応いただくことは可能でしょうか。
>いつもお世話になっております。何卒よろしくお願いいたします。

という投稿があり、制限なんてしてないんだけどなんでかな？？と調べてみたところ
以下の記事を発見。こりゃまいったね。。。ハイパーリンクを使わずになんとかそれっぽいジャンプをできるようにしないと。

Excel2010で65,530個を超えるハイパーリンクは挿入できない
https://answers.microsoft.com/ja-jp/msoffice/forum/msoffice_excel-mso_winother-mso_2010/excel2010%E3%81%A765530%E5%80%8B%E3%82%92%E8%B6%85/c42e7a67-e691-4e5c-8d00-aa2db19ab5a1?auth=1

今の言語は必ずIterator(For Eash)があってとても簡単にループが作成できて便利なのだが、For Each を使って集計処理をすると以下のようなロジックになる場合が多い。

For Each を使用した集計処理

Dim col As Collection
    Dim v As Variant
    Dim strWork As String
    Dim lngCnt As Long
    
    Set col = New Collection
    
    col.Add "あ"
    col.Add "い"
    col.Add "い"
    col.Add "う"
    col.Add "え"
    col.Add "え"
    col.Add "お"
    col.Add "お"

    strWork = ""
    lngCnt = 0
    
    For Each v In col
    
        If v <> strWork Then
            
            '初回
            If strWork <> "" Then
                Debug.Print strWork & lngCnt
            End If
        
            strWork = v
            lngCnt = 0
        
        End If
        
        lngCnt = lngCnt + 1
    
    Next

    '集計結果を表示する前にループを抜けてしまう。
    If v <> strWork Then
        Debug.Print strWork & lngCnt
    End If

あ1
い2
う1
え2
お2

かといって、コレクションをカーソル風に読むのはわりと面倒。というわけで、コレクションを カーソル風に読むクラスを作成してみた。

カーソル風コレクション読み込みクラス

'------------------------------------------------------
' カーソル風コレクション読み込みクラス
'------------------------------------------------------
Option Explicit

Private mCol As Collection
Private mIndex As Long
Private Sub Class_Initialize()
    mIndex = 0
End Sub
Private Sub Class_Terminate()
    Set mCol = Nothing
End Sub
'------------------------------------------------------
' コンストラクタ
'------------------------------------------------------
Public Sub Init(col As Collection)
 
    Set mCol = col
    Me.MoveFirst
    
End Sub
'------------------------------------------------------
' 終了判定 
'------------------------------------------------------
Property Get Eof() As Boolean

    If mCol Is Nothing Then
        Eof = True
        Exit Sub
    End If
    Eof = mCol.Count < mIndex

End Property
'------------------------------------------------------
' 最初の行に移動
'------------------------------------------------------
Public Sub MoveFirst()
    mIndex = 1
End Sub
'------------------------------------------------------
' 次行取得
'------------------------------------------------------
Public Sub MoveNext()
    mIndex = mIndex + 1
End Sub
'------------------------------------------------------
' セル取得
'------------------------------------------------------
Public Property Get item() As Variant

    If Me.Eof Then
        'EOF後は最後の値を返す
        If IsObject(mCol(mCol.Count)) Then
            Set item = mCol(mCol.Count)
        Else
            item = mCol(mCol.Count)
        End If
    Else
        If IsObject(mCol(mIndex)) Then
            Set item = mCol(mIndex)
        Else
            item = mCol(mIndex)
        End If
    End If
End Property

MoveNext を用いた集計処理

上記のクラスを使えば、記述内容がすっきりする。

Dim col As Collection
    Dim v As Variant
    Dim strWork As String
    Dim lngCnt As Long
    
    Set col = New Collection
    
    col.Add "あ"
    col.Add "い"
    col.Add "い"
    col.Add "う"
    col.Add "え"
    col.Add "え"
    col.Add "お"
    col.Add "お"
    
    Dim cc As CollectionCursor
    
    Set cc = New CollectionCursor
    cc.Init col
    
    Do Until cc.Eof
    
        '初期化
        strWork = cc.item
        lngCnt = 0
            
        '集計処理
        Do Until cc.Eof Or strWork <> cc.item
    
            lngCnt = lngCnt + 1
            
            cc.MoveNext
        Loop
        
        '集計結果
        Debug.Print strWork & lngCnt
        
   Loop

あ1
い2
う1
え2
お2

見てわかる通り、初期化を行う場所、集計する場所、修正結果を表示する場所が一目瞭然であると思う。ループの中で次のコレクションに移動できないとこういったロジックを書くことができない。

Windows上で、SJIS 以外の文字列を扱うことが普通になっていますが、VBAで文字化けさせずに処理を行うのはちょっとコツがいります。
VBAの内部構造で、String型はUNICODEで保持されますが、APIやファイルに書き出すと自動的にS-JIS(正確にはCP932)に変換されてしまいます。
Stringの中身が外に出ていくときにはイメージ的にはStrConv(xxx, vbUnicode)が自動的にかかる感じ。
これを回避するためには書き方を変える必要があります。

APIの場合

1. API の場合 W 付きのものを使用する。(又はマニュアルでUnicodを扱う方法が記述されていればその方法）
2. API の引数は ByVal のLongPtr 型にする。
3. 文字列にStrPtrをかけてアドレスを渡す。

'Excel 2010 以降 32/64bit対応
Private Declare PtrSafe Function SearchTreeForFileW Lib "dbghelp" (ByVal RootPath As LongPtr, ByVal InputPathName As LongPtr, ByVal OutputPathBuffer As LongPtr) As Long

'--------------------------------------------------------------
'　ファイル検索(フィルタ高速版)
' 指定のファイルがファイルが見つかったら即リターンします。
'--------------------------------------------------------------
Public Function SearchTreeForFile(ByVal strPath As String, ByVal strFile As String) As String
    Dim strBuffer As String

    strBuffer = String$(MAX_PATH, vbNullChar)

    SearchTreeForFile = ""

    If SearchTreeForFileW(StrPtr(strPath), StrPtr(strFile), StrPtr(strBuffer)) Then
        SearchTreeForFile = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
    End If

End Function

ファイル出力の場合

1. バイナリーモードでオープンする。
2. String 型の文字列を Byte 型の可変型変数に代入
3. Put で出力する。

Dim bytBuf() As Byte
Dim fp As Integer

fp = FreeFile
Open "a.txt" For Binary As fp

bytBuf = "ああああ"
Put #fp, , bytBuf

Close

可変長のByte型はString 型の文字が入るというのがミソではある。

エクスプローラのコピー情報を取り出す処理をもともと作成していたが、ANSI版を呼んでいて、UNICODE対応していなかったことと、微妙なバグ、Excel 2007を対象外としたことでとてもシンプルな記述にした。２ファイル以上の場合、CRLFで区切って返却。

Excelバージョン:Excel 2010 以上
32bit/64bit版 UNICODE対応

’Excel 2010 以降 32/64bit 対応
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function DragQueryFileW Lib "shell32.dll" (ByVal hDrop As LongPtr, ByVal UINT As Long, ByVal lpszFile As LongPtr, ByVal ch As Long) As Long
Private Const CF_HDROP As Long = 15
'--------------------------------------------------------------
'　クリップボードからファイル名を取得
'--------------------------------------------------------------
Public Function GetCopyClipText() As String

    Dim hData As LongPtr
    Dim files As Long
    Dim i As Long
    Dim strFilePath As String
    Dim ret As String
    
    If OpenClipboard(0) <> 0 Then
   
        hData = GetClipboardData(CF_HDROP)
        
        If Not IsNull(hData) Then
            
            'ファイルの数を取得
            files = DragQueryFileW(hData, -1, 0, 0)
            For i = 0 To files - 1 Step 1
                
                'サイズを取得
                Dim lngSize As Long
                lngSize = DragQueryFileW(hData, i, 0, 0)
                
                'DragQueryFileWの返却するサイズは終端を含まない
                strFilePath = String$(lngSize + 1, vbNullChar)
                
                lngSize = DragQueryFileW(hData, i, StrPtr(strFilePath), Len(strFilePath))
                
                If i = 0 Then
                    ret = Left$(strFilePath, lngSize)
                Else
                    ret = ret & vbCrLf & Left$(strFilePath, lngSize)
                End If
            Next
        End If
        Call CloseClipboard
    
    End If
    
    GetCopyClipText = ret
    
End Function

テーブル機能は便利だ。VBAで読むにしてもデータの範囲が決まっているのがありがたい。

今までは「セルが空白になったら」とか 「UsedRangeの範囲外になったら」「印刷範囲外になったら」などの割合あいまいな終了条件を書くことが多かったからだ。テーブル機能を使う場合、列の内容を取得する場合、EnumやConstで定義した列番号でアクセスするのが一般的だ。

しかし、ACCESSやDBでよく使うような列名が使いたい。だってテーブル機能にはヘッダが合って列名があるじゃん！それ使えないんかい！ということで、以前も紹介した集計処理に使用できる Cursorクラスをテーブル用に作成した。

ブレイク処理対応テーブル読み込みクラス

'------------------------------------------------------------------------
' ブレイク処理対応テーブル読み込みクラス
'------------------------------------------------------------------------
Option Explicit

Private LO As ListObject
Private WS As Worksheet
Private lngStartRow As Long
Private lngRow As Long
Private lngLastRow As Long
'------------------------------------------------------
' コンストラクタ
'------------------------------------------------------
Public Sub Init(sheet As Worksheet)
    
    Set WS = sheet
    Set LO = WS.ListObjects(1)
    
    'データの最初の行
    lngStartRow = LO.DataBodyRange(1).Row
    
    'データの最後の行
    lngLastRow = LO.DataBodyRange(LO.DataBodyRange.Count).Row
    
    'カレント行
    lngRow = lngStartRow
    
    SkipHiddenRow

End Sub
'------------------------------------------------------
' 終了判定
'------------------------------------------------------
Property Get Eof() As Boolean
    Eof = (lngRow > lngLastRow Or lngRow < 1)
End Property
'------------------------------------------------------
' 最初の行に移動
'------------------------------------------------------
Sub MoveFirst()
    lngRow = lngStartRow
    SkipHiddenRow
End Sub
'------------------------------------------------------
' 次行取得
'------------------------------------------------------
Sub MoveNext()
    lngRow = lngRow + 1
    SkipHiddenRow
End Sub
'------------------------------------------------------
' セル取得
'------------------------------------------------------
Property Get item(ByVal strCol As String) As Range
    
    Set item = WS.Cells(lngRow, LO.ListColumns(strCol).Range(1).Column)
    
End Property
'------------------------------------------------------
' 非表示行をスキップ
'------------------------------------------------------
Private Sub SkipHiddenRow()
    Do Until Not WS.Rows(lngRow).Hidden Or Me.Eof
        lngRow = lngRow + 1
    Loop
End Sub

Private Sub Class_Terminate()
    Set LO = Nothing
    Set WS = Nothing
End Sub

56行目の LO.ListColumns(strCol).Range(1).Column で列名から列番号に変換をかけている。

テーブルの指定がシートに１つ目固定になっているので適宜修正していただきたい。

非表示行をスキップするようになっているのでそっちも適宜で。

このようなテーブル機能で作成された表を読むこととする。

呼び出し側

Sub 呼び出し側()

    Dim tc As TableCursor
    
    Set tc = New TableCursor
    
    tc.Init Sheet1
    
    Do Until tc.Eof

       Debug.Print tc.item("id").Value
       Debug.Print tc.item("ja").Value
       Debug.Print tc.item("en").Value
        
        tc.MoveNext
    Loop

End Sub

どうだろうか。便利だと思うのだが。

元ネタはこちら

参考サイト

愚者の経験 – コンストラクタで引数を入れたい
https://foolexp.wordpress.com/2012/02/21/%E3%82%B3%E3%83%B3%E3%82%B9%E3%83%88%E3%83%A9%E3%82%AF%E3%82%BF%E3%81%A7%E5%BC%95%E6%95%B0%E3%82%92%E5%85%A5%E3%82%8C%E3%81%9F%E3%81%84/

愚者の経験 – クラスモジュールにも「規定のインスタンス」
https://foolexp.wordpress.com/2012/02/24/%E3%82%AF%E3%83%A9%E3%82%B9%E3%83%A2%E3%82%B8%E3%83%A5%E3%83%BC%E3%83%AB%E3%81%AB%E3%82%82%E3%80%8C%E6%97%A2%E5%AE%9A%E3%81%AE%E3%82%A4%E3%83%B3%E3%82%B9%E3%82%BF%E3%83%B3%E3%82%B9%E3%80%8D/

t-hom’s diary – VBAでインターフェースを使って引数付きのコンストラクタを実現する。
https://thom.hateblo.jp/entry/2015/02/15/012503

VBAでインターフェースを使って引数付きのコンストラクタを実現するやり方を模索していたのですが、かなり強引な方法ですが、ほぼやりたいことができたのでやり方を公開します。t-homさんも言っていますが疑似引数付コンストラクタです。（裏技的な感じがハンパないです・・・。）

結果どうなったか

以下、記述にて疑似コンストラクタの記述ができるようになりました。IConstructor クラスを追加するだけで、標準モジュールを不要にしました。

Set sb = IConstructor.Instancing(New StringBuilder, 1000)

IConstructorは初期のインスタンスをあたえて、そのままクラス名で呼べるようにします。New したクラスと引数を指定します。引数の指定は好みですが、２つのInstancingメソッドでの引数の受け渡しでParam Array が使いづらいので複数指定の時にはArrayで渡すようにしました。

Sub Test()

    Dim sb As StringBuilder
    
    'コンストラクタで複数の引数を渡す場合はArrayで渡す。
    'Set sb = IConstructor.Instancing(New StringBuilder, Array(1000, 2000))
    
    Set sb = IConstructor.Instancing(New StringBuilder, 1000)
    
    Dim i As Long
    
    For i = 1 To 1000
    
        sb.Append CStr(i)
    
    Next
    
    Debug.Print sb.ToString

End Sub

以下、実現方法です。

Interfaceクラスの説明

IConstructor というInterfece クラスを１つ作成します。

キモは「Attribute VB_PredeclaredId = True」でクラスに規定のインスタンスを与えることです。
規定のインスタンスとはクラスをNewしなくても、インスタンスが１つ生成され、クラス名でメンバにアクセスが可能になります。他言語でいう Static なクラスです。

このプロパティはプロパティウィンドウでは書き換えられないので一度、EXPORTした後、値をTrueに変更、インポートします。
本来のこのクラスは Interface に使用するので、Instancing メソッドの中身を書く必要はありません。しかし、このクラス自体は普通のクラス扱い（呼び出し先はImplementsを書くけど）
なので、コンストラクタに引数を渡すヘルパー関数として利用します。参考にしたサイトでは標準モジュールを利用していましたのでその改善になります。

以下、Export した状態のクラス。８行目を True にする。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "IConstructor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'---------------------------------------------------
' コンストラクタ呼び出し
'---------------------------------------------------
Public Function Instancing(ClassObject As Object, ByVal Args As Variant) As Object
    
    Dim c As IConstructor
    
    Set c = ClassObject
    
    '引数が１つの場合Arrayにする必要がない。コンストラクタ内でIsArrayするのが面倒なので常に Array する。
    If Not IsArray(Args) Then
        Args = Array(Args)
    End If
    
    Set Instancing = c.Instancing(ClassObject, Args)

End Function

コンストラクタを作成したクラスの説明

こちらはサンプルのクラスとして、以前作っていた StringBuilder クラスですが、これにInterfaceを用いて引数付のコンストラクタを作成します。
「Implements IConstructor」を記述し、作成される「IConstructor_Instancing」メソッドの中に初期化の内容を記述します。

'-----------------------------------------------------------------------------------------------------
' 文字列連結クラス
'-----------------------------------------------------------------------------------------------------
Option Explicit
Implements IConstructor

Private mstrBuf() As String
Private mlngCount As Long
Private mlngLength As Long
Private Const C_INIT_COUNT As Long = 25
Private mlngInitCount As Long
'------------------------------------------------------
' 初期化
'------------------------------------------------------
Private Sub Class_Initialize()
    mlngInitCount = C_INIT_COUNT
    Me.Clear
End Sub
'------------------------------------------------------
' 終了
'------------------------------------------------------
Private Sub Class_Terminate()
    Erase mstrBuf
End Sub
'------------------------------------------------------
' コンストラクタ　初期配列サイズの変更
'------------------------------------------------------
Private Function IConstructor_Instancing(ClassObject As Object, ByVal Args As Variant) As Object

    If UBound(Args) <> -1 Then
        mlngInitCount = Args(0)
        Me.Clear
    End If
    
    Set IConstructor_Instancing = ClassObject
    
End Function
'------------------------------------------------------
' クリア
'------------------------------------------------------
Public Sub Clear()
    
    Erase mstrBuf
    ReDim Preserve mstrBuf(0 To mlngInitCount)
    
    mlngCount = 0
    mlngLength = 0

End Sub
'------------------------------------------------------
' 追加
'------------------------------------------------------
Function Append(ByVal s As String)

    '配列にセット
    If mlngCount > UBound(mstrBuf) Then
        ReDim Preserve mstrBuf(0 To mlngCount)
    End If
    mstrBuf(mlngCount) = s
    
    '文字数をカウント
    mlngLength = mlngLength + Len(s)
    
    '要素数＋１
    mlngCount = mlngCount + 1

End Function
'------------------------------------------------------
' 文字列変換
'------------------------------------------------------
Function ToString()

    Call resize
    ToString = Join(mstrBuf, "")

End Function
'------------------------------------------------------
' 文字列変換(JOIN)
'------------------------------------------------------
Function ToJoin(ByVal strDelimiter As String)
    
    Call resize
    ToJoin = Join(mstrBuf, strDelimiter)

End Function
'------------------------------------------------------
' 文字列変換前のリサイズ
'------------------------------------------------------
Private Sub resize()
    
    Select Case mlngCount
        Case Is <= 0
            ReDim Preserve mstrBuf(0 To 0)
        Case Is < mlngInitCount
            ReDim Preserve mstrBuf(0 To mlngCount - 1)
    End Select

End Sub
'------------------------------------------------------
' 文字数
'------------------------------------------------------
Public Property Get Length() As Long
    Length = mlngLength
End Property
'------------------------------------------------------
' 置換
'------------------------------------------------------
Public Sub Replace(ByVal strFind As String, ByVal strReplace As String)

    Dim strBuf As String

    strBuf = Me.ToString
    
    Me.Clear
    
    Me.Append VBA.Replace(strBuf, strFind, strReplace)

End Sub

呼び出し側と呼び出されたコンストラクタの引数が一致しているため（そもそもそれがInterfaceの役割ですが）イイ感じにリンクできている感じです。
もうちょっと Param Array 同士の受け渡しがうまくいけばなぁ～。という感じ。

サンプルダウンロード(constructor.xlsm)

小ネタ。通常midは文字列から一部を取り出す関数だが、実は代入もできる。
ちなみにしていした桁より多くの文字を代入しても指定文字以上は設定できない。

Sub Test()

    Dim strBuf As String
    
    strBuf = "123456"

    '通常の使い方
    Debug.Print Mid(strBuf, 3, 2)

    '実は代入もできるMID
    Mid(strBuf, 3, 2) = "ABC"

    Debug.Print strBuf

End Sub

Cは桁数オーバーなので入らない

34
12AB56

今年は、元号の発表があるからエイプリルフールは中止らしいですね。
兵〇県警につかまっちゃうよ的なお話もあるようですし、しょうがないですね。

そういえば、去年Excel方眼死していた私ですが、
その間、異世界に行っていました、初心者がよく作るプログラムの文言に１文足すだけで異世界に行けてしまうとは。
皆さんもゆめゆめ気を付けてくださいね。

コンストラクタに渡した文字列を１文字ずつ処理するクラスを作成、カーソル風操作部分をInterface化。
他のクラスにも適用するようにした。
使い方は以下のように非常にシンプルになる。

呼び出し方法１

以下はインスタンスをICursorに設定して実行する方法。

Sub Test()

    Dim IC As ICursor
    
    Set IC = IConstructor(New CharCursor, "0123456789")
    Do Until IC.Eof
    
        Debug.Print IC
        
        IC.MoveNext
    Loop
    
End Sub

0
1
2
3
4
5
6
7
8
9

呼び出し方法２

以下はインスタンスをCharCursorに設定して GetCursor で ICursor インターフェースを取得し、実行する方法。
こちらは、CharCursor のメソッドも使える（この例ではGetCursor しかないけどメソッド、プロパティがあれば呼べる）し、ICursor のメソッドも使える。

Sub Test2()

    Dim CC As CharCursor
    
    Set CC = IConstructor(New CharCursor, "0123456789")
    
    With CC.GetCursor
        
        Do Until .Eof
        
            Debug.Print .Item
            
            .MoveNext
        Loop
    
    End With
    
End Sub

0
1
2
3
4
5
6
7
8
9

カーソル風操作のメソッドを定義

※以下ソースはファイルに保存してからインポートしてください。
Item プロパティが規定のプロパティになるように以下設定をする。Interface に設定すれば実装にもちゃんと効く。
Attribute Item.VB_UserMemId = 0

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ICursor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Property Get Eof() As Boolean
End Property
Public Sub MoveFirst()
End Sub
Public Sub MoveNext()
End Sub
Public Property Get Item(Optional ByVal opt As Variant) As Variant
Attribute Item.VB_UserMemId = 0
End Property
Public Property Get PreviousItem(Optional ByVal opt As Variant) As Variant
End Property

カーソル風操作のメソッドの実装

※以下ソースはファイルに保存してからインポートしてください。
IConstructor, ICursor の２つのインターフェースを定義。特に複数Interfaceを定義しても問題ありません。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CharCursor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'-----------------------------------------------------------------------------------------------------
' カーソル風文字列読み込みクラス
'-----------------------------------------------------------------------------------------------------
Option Explicit
Implements IConstructor
Implements ICursor

Private mBuf As String
Private mIndex As Long
Private Sub Class_Initialize()
    mIndex = 1
End Sub
'------------------------------------------------------
' コンストラクタ
'------------------------------------------------------
Private Function IConstructor_Instancing(ClassObject As Object, ParamArray Args()) As Object

    Select Case UBound(Args)
        Case 0
            mBuf = CStr(Args(0))
            ICursor_MoveFirst
        Case Else
            'エラー
            Exit Function
    End Select
    
    Set IConstructor_Instancing = Me

End Function
'--------------------------------------------------------------
' ICursor インターフェースを取得
'--------------------------------------------------------------
Public Property Get GetCursor() As ICursor
    Set GetCursor = Me
End Property
'------------------------------------------------------
' 終了判定
'------------------------------------------------------
Private Property Get ICursor_Eof() As Boolean
    ICursor_Eof = Len(mBuf) < mIndex
End Property
'------------------------------------------------------
' 最初の行に移動
'------------------------------------------------------
Private Sub ICursor_MoveFirst()
    mIndex = 1
End Sub
'------------------------------------------------------
' 次行取得
'------------------------------------------------------
Private Sub ICursor_MoveNext()
    mIndex = mIndex + 1
End Sub
'------------------------------------------------------
' 文字取得
'------------------------------------------------------
Private Property Get ICursor_Item(Optional ByVal opt As Variant) As Variant

    Dim lngPos As Long
    
    lngPos = mIndex

    If lngPos < 1 Or lngPos > Len(mBuf) Then
        ICursor_Item = ""
    Else
        ICursor_Item = Mid$(mBuf, lngPos, 1)
    End If

End Property
'------------------------------------------------------
' 前の文字取得
'------------------------------------------------------
Private Property Get ICursor_PreviousItem(Optional ByVal opt As Variant) As Variant
    
    Dim lngPos As Long
    
    lngPos = mIndex - 1

    If lngPos < 1 Or lngPos > Len(mBuf) Then
        ICursor_PreviousItem = ""
    Else
        ICursor_PreviousItem = Mid$(mBuf, lngPos, 1)
    End If

End Property

コンストラクタ用インターフェース

※以下ソースはファイルに保存してからインポートしてください。

Instancing プロパティが規定のプロパティになるように以下を設定をする。
Attribute Item.VB_UserMemId = 0

規定のインスタンスが生成されるように以下を設定する。
Attribute VB_PredeclaredId = True

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "IConstructor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'---------------------------------------------------
' コンストラクタ呼び出し
'---------------------------------------------------
Public Function Instancing(ThisObject As Object, ParamArray Args()) As Object
Attribute Instancing.VB_UserMemId = 0
    
    Dim c As IConstructor
    Dim pa() As Variant
    Dim max As Long
    Dim i As Long
    
    Set c = ThisObject
    
    max = UBound(Args)
    
    If max >= 0 Then
    
        Select Case max
            Case 0
                Set Instancing = c.Instancing(ThisObject, Args(0))
            Case 1
                Set Instancing = c.Instancing(ThisObject, Args(0), Args(1))
            Case 2
                Set Instancing = c.Instancing(ThisObject, Args(0), Args(1), Args(2))
            Case 3
                Set Instancing = c.Instancing(ThisObject, Args(0), Args(1), Args(2), Args(3))
            Case 4
                Set Instancing = c.Instancing(ThisObject, Args(0), Args(1), Args(2), Args(3), Args(4))
            Case 5
                Set Instancing = c.Instancing(ThisObject, Args(0), Args(1), Args(2), Args(3), Args(4), Args(5))
            Case 6
                Set Instancing = c.Instancing(ThisObject, Args(0), Args(1), Args(2), Args(3), Args(4), Args(5), Args(6))
            Case 7
                Set Instancing = c.Instancing(ThisObject, Args(0), Args(1), Args(2), Args(3), Args(4), Args(5), Args(6), Args(7))
            Case 8
                Set Instancing = c.Instancing(ThisObject, Args(0), Args(1), Args(2), Args(3), Args(4), Args(5), Args(6), Args(7), Args(8))
            Case 9
                Set Instancing = c.Instancing(ThisObject, Args(0), Args(1), Args(2), Args(3), Args(4), Args(5), Args(6), Args(8), Args(8), Args(9))
            Case Else
                Err.Raise vbObjectError + 512 + 1, "Argument Error"
        End Select
        
    Else
        Set Instancing = c.Instancing(ThisObject)
    End If
    
    '各Instancingメソッド内で設定されなかった場合、エラー
    If Instancing Is Nothing Then
        Err.Raise vbObjectError + 512 + 1, "Argument Error"
    End If
    
End Function

以下のようなロジックを組んでいていろいろな終了処理めんどくせぇ～
一発でなんとかなんねーかということで、Interface でなんとかしてみた。
かなりめんどくささを強調しているのであまりつっこまないように。

下記の例だと、
・Application.ScreenUpdating の設定
・別Excel 起動時の終了処理
・処理中フォームの開始・終了処理
の処理が面倒な感じです。C# なら Using句とかで自動で終了できて便利ですね。

ありがちな例

Sub MainMae()

    Dim lngCount As Long
    Dim lngMax As Long
    Dim blnCancel As Boolean
    
    If MsgBox("実行しますか？", vbQuestion + vbOKCancel) <> vbOK Then
        Exit Sub
    End If
    
    On Error GoTo e
    
    lngCount = 0
    lngMax = 100000
    
    frmWait.TitleBar = "サンプル"
    frmWait.Message = "テスト中..."
    
    Dim XL As Excel.Application
    Set XL = New Excel.Application
    
    frmWait.Show
    
    Application.ScreenUpdating = False
    Application.Cursor = xlWait
    
    frmWait.StartGauge lngMax
    
    '別プロセスでのExcel起動
    XL.Visible = True
    
    Do Until lngCount > lngMax
    
        If frmWait.IsCancel Then
            blnCancel = True
            Exit Do
        End If
        
        lngCount = lngCount + 1
        frmWait.DisplayGauge lngCount
    Loop

    Unload frmWait
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault

    XL.Quit
    Set XL = Nothing

    If blnCancel Then
        MsgBox "キャンセルされました。", vbExclamation
    Else
        MsgBox "完了", vbInformation
    End If
    Exit Sub
e:
    Unload frmWait
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
    
    XL.Quit
    Set XL = Nothing
    
    MsgBox "エラーです。", vbCritical

End Sub

ソース

以下、いくつかクラスを作成します。
インターフェイス IConstructorを定義する。

Option Explicit
'---------------------------------------------------
' コンストラクタ呼び出し
'---------------------------------------------------
Public Function Instancing(ByRef Args As Collection) As Object
End Function

インターフェイス IUsing を定義する。

Option Explicit
Public Sub Begin()
End Sub
Public Sub Finish()
End Sub

Excel の高速化クラスを作成、インターフェイス IUsing をImplimentsし、Begin/Finishメソッドに内容を記述する。
参考）VBA マクロの高速化のためのApplication設定をクラスモジュールにまとめる

Option Explicit
Implements IUsing

Private mScreenUpdating As Boolean
Private mCalculation As XlCalculation
Private mEnableEvents As Boolean
Private mPrintCommunication As Boolean
Private mDisplayAlerts As Boolean

Private Sub IUsing_Begin()
    
    'Applicationのプロパティを保存する。
    With Application
        mScreenUpdating = .ScreenUpdating
        mCalculation = .Calculation
        mEnableEvents = .EnableEvents
        mPrintCommunication = .PrintCommunication
        mDisplayAlerts = .DisplayAlerts
    End With

    'Applicationのプロパティを変更する。
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .PrintCommunication = False
        .DisplayAlerts = False
        
        .Cursor = xlWait
    End With

End Sub

Private Sub IUsing_Finish()
    
    'Applicationのプロパティを復元する。
    With Application
        .ScreenUpdating = mScreenUpdating
        .Calculation = mCalculation
        .EnableEvents = mEnableEvents
        .PrintCommunication = mPrintCommunication
        .DisplayAlerts = mDisplayAlerts
        
        .Cursor = xlDefault
        .StatusBar = False
    
    End With

End Sub

Excel の起動クラスを作成、インターフェイス IUsing を同様に適用する。

Option Explicit
Implements IUsing

Private mXL As Excel.Application
'Instance を取得時にオブジェクトを生成する。
Public Property Get GetInstance() As Excel.Application
    If mXL Is Nothing Then
        Set mXL = New Excel.Application
        mXL.EnableEvents = False
        mXL.PrintCommunication = False
        mXL.DisplayAlerts = False
    End If
    Set GetInstance = mXL
End Property

Private Sub Class_Terminate()
    Call IUsing_Finish
End Sub

Private Sub IUsing_Begin()

End Sub

Private Sub IUsing_Finish()
    
    If Not mXL Is Nothing Then
        mXL.Quit
    End If
    Set mXL = Nothing

End Sub

処理中フォームで インターフェイス IUsing を同様に適用する。
フォームもクラスなのでインターフェースが使えます。余談ですが UserForm型って挙動がインターフェースっぽいな。

Option Explicit
Implements IUsing

'処理をざっくり省略

'--------------------------------------------------------------
' IUsing I/F Begin
'--------------------------------------------------------------
Private Sub IUsing_Begin()
    m_Cancel = False
    Me.Show
End Sub
'--------------------------------------------------------------
' IUsing I/F Finish
'--------------------------------------------------------------
Private Sub IUsing_Finish()
    Unload Me
End Sub

コンストラクタのヘルパー関数

Option Explicit
'自クラスまたはCollectionのコンストラクタを定義
Public Function Constructor(ByRef obj As Object, ParamArray Args() As Variant) As Object

    Dim c As IConstructor
    Dim v As Variant
    
    '引数をCollectionに詰め替える
    Dim col As Collection
    Set col = New Collection
    For Each v In Args
        col.Add v
    Next
        
    'IConstructor Interfaceを呼び出す。
    Set c = obj
    Set Constructor = c.Instancing(col)
    
    'オブジェクトが返却されなかった場合エラー
    If Constructor Is Nothing Then
        Err.Raise vbObjectError + 512 + 1, "Argument Error"
    End If

End Function

Using クラスを作成、コンストラクタで各オブジェクトをコレクションに登録、各オブジェクトのBegin メソッドを呼び出す。
また、 Class_Terminate　にて各オブジェクトのFinishメソッドを呼び出す。
これにより、IUsingインターフェースのあるクラスであれば、指定されたメソッドの開始処理、終了処理を一括して行うことが可能となります。

Option Explicit
Implements IConstructor

Private m_col As Collection
'--------------------------------
' With 時点で実行
'--------------------------------
Private Function IConstructor_Instancing(Args As Collection) As Object

    Dim v As IUsing

    If Args.Count = 0 Then
        Exit Function
    End If

    Set m_col = Args

    For Each v In m_col
        v.Begin
    Next
    
    Set IConstructor_Instancing = Me

End Function
'--------------------------------
'End With 時点で実行
'--------------------------------
Private Sub Class_Terminate()

    Dim v As IUsing
    Dim i As Long
    
    'IUsingI/F同士に関連があるとアレなので、逆順に実行
    For i = m_col.Count To 1 Step -1
        Set v = m_col(i)
        v.Finish
    Next
    
    Set m_col = Nothing

End Sub
'--------------------------------
' Args
'--------------------------------
Public Property Get Args() As Collection
    Set Args = m_col
End Property

改善後

改善後の記述は以下のようになります。すっきりしましたね。
End With で UsingクラスのClass_Terminateが実行され、各クラスのFinishメソッドが実行されます。
エラーの時にはUsingオブジェクトがスコープ外になった時に各クラスのFinishメソッドが実行され、処理のこりが防止できます。

Sub Main()

    Dim lngCount As Long
    Dim lngMax As Long
    Dim blnCancel As Boolean
    
    If MsgBox("実行しますか？", vbQuestion + vbOKCancel) <> vbOK Then
        Exit Sub
    End If
    
    On Error GoTo e
    
    lngCount = 0
    lngMax = 100000
    
    frmWait.TitleBar = "サンプル"
    frmWait.Message = "テスト中..."
    
    Dim XL As NewExcel
    
    Set XL = New NewExcel
    
    'なんちゃってUsingに IUsing I/F に対応したクラスを指定する。
    With Constructor(New Using, XL, New OneTimeSpeedBooster, frmWait)
    
        frmWait.StartGauge lngMax
        
        '別プロセスでのExcel起動
        XL.GetInstance.Visible = True
        
        Do Until lngCount > lngMax
        
            If frmWait.IsCancel Then
                blnCancel = True
                Exit Do
            End If
            
            lngCount = lngCount + 1
            frmWait.DisplayGauge lngCount
        Loop

    End With
    'IUsing I/Fに対応したクラスはここで終了する。

    If blnCancel Then
        MsgBox "キャンセルされました。", vbExclamation
    Else
        MsgBox "完了", vbInformation
    End If
    Exit Sub
e:
    MsgBox "エラーです。", vbCritical
End Sub

サンプルダウンロード(Using.xlsm)

ログの出力はデバッグでは重要ですね。処理時間も重要ですが、あまり手間なくログを出力したいですよね。
これはログ出力のワンライナーです（嘘）

呼び出し方法

以下、基本プロシージャの１行目に追加して、メソッド名（プロシージャ名）を書き換えるという作業になります。（これさえなくなればさらに楽なのだが）
終了寺のログ出力を書く必要がありません。変数PLがスコープ外になった時にPairLoggerのインスタンスが消滅、終了ログが出力されるという寸法です。

クラスモジュールの場合
TypeName(Me)が使えるので標準モジュールよりはちょっと楽？

Option Explicit
Sub Test()
    Dim PL As PairLogger: Set PL = Constructor(New PairLogger, TypeName(Me) & ".Test")
    
    Dim i As Long
    For i = 1 To 10000
        DoEvents
    Next

End Sub

標準モジュールの場合

Option Explicit
Sub Main()

    Dim PL As PairLogger: Set PL = Constructor(New PairLogger, "Module1.Main")

    Dim i As Long
    
    For i = 1 To 10000
        DoEvents
    Next
    
    Dim c As Class1
    
    Set c = New Class1
    
    c.Test

End Sub

ログ出力結果（イミディエイトウィンドウ）

2019-06-01,11:30:00.559,[1]Module1.Main,BEGIN
2019-06-01,11:30:01.156,[2]Class1.Test,BEGIN
2019-06-01,11:30:01.738,[2]Class1.Test,FINISH,[578]ms
2019-06-01,11:30:01.742,[1]Module1.Main,FINISH,[1188]ms

ソース

ログ出力クラスです。簡略化したものです。（イミディエイトウィンドウに表示されます）
Attribute VB_PredeclaredId = True　にし、New しなくても実行できるようにします。（エクスポートして、Trueに書き換えてインポートが必要）

' このクラスは Staticクラス(Attribute VB_PredeclaredId = True) です。
Option Explicit

#If Win64 Then
    Private Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount64" () As LongPtr
#Else
    Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#End If

'スタック
Private colStack As New Collection
'--------------------------------------------------------------
'　開始ログ
'--------------------------------------------------------------
Public Sub LogBegin(Message As String, ParamArray p())
    
    If colStack Is Nothing Then
        Set colStack = New Collection
    End If
    
    ReportLog "[" & colStack.Count + 1 & "]" & PlaceHolder(Message, p) & ",BEGIN"

    colStack.Add GetTickCount

End Sub
'--------------------------------------------------------------
'　終了ログ
'--------------------------------------------------------------
Public Sub LogFinish(Message As String, ParamArray p())
    
    Dim t As LongPtr

    If colStack Is Nothing Then
        t = 0
    Else
        If colStack.Count = 0 Then
            t = 0
        Else
            t = colStack.Item(colStack.Count)
            colStack.Remove colStack.Count
        End If
    End If
    
    If t = 0 Then
        ReportLog PlaceHolder(Message, p) & ",FINISH,[?]ms"
    Else
        t = GetTickCount - t
        ReportLog "[" & colStack.Count + 1 & "]" & PlaceHolder(Message, p) & ",FINISH,[" & t & "]ms"
    End If
    
End Sub
'ログ出力
Private Sub ReportLog(ByVal strMsg As String)

    Dim strLog As String

    strLog = Format$(Now, "yyyy-mm-dd,hh:nn:ss") & "." & getMSec & "," & strMsg
    Debug.Print strLog

End Sub
'時間の取得(ms)
Private Function getMSec() As String

    Dim dblTimer As Double

    dblTimer = CDbl(Timer)
    getMSec = Format$((dblTimer - Fix(dblTimer)) * 1000, "000")

End Function
'プレースホルダ変換
Private Function PlaceHolder(ByVal strMsg As String, ByVal p As Variant) As String

    If UBound(p) >= 0 Then
        Dim i As Long
        For i = 0 To UBound(p)
            strMsg = Replace(strMsg, "{" & CStr(i) & "}", p(i))
        Next
    End If

    PlaceHolder = strMsg

End Function

最近はやりの（自分の中だけ）コンストラクタ I/F （クラス）

Option Explicit
Public Function Instancing(ByRef Args As Collection) As Object
End Function

コンストラクタ生成ヘルパー（標準モジュール）

'-----------------------------------------------------------------------------------------------------
' コンストラクタ生成
'-----------------------------------------------------------------------------------------------------
Option Explicit

Public Function Constructor(ByRef obj As Object, ParamArray Args() As Variant) As Object

    Dim c As IConstructor
    Dim v As Variant
    
    '引数をCollectionに詰め替える
    Dim col As Collection
    Set col = New Collection
    For Each v In Args
        col.Add v
    Next
    
    'IConstructor Interfaceを呼び出す。
    Set c = obj
    Set Constructor = c.Instancing(col)
    
    'オブジェクトが返却されなかった場合エラー
    If Constructor Is Nothing Then
        Err.Raise vbObjectError + 512 + 1, "Argument Error"
    End If

End Function

ペアロガークラス
今回のキモとなるクラスです。Class_Terminateで終了ログを出力するのがキモになります。

'-----------------------------------------------------------------------------------------------------
' 関数の開始／終了のメッセージを１行で出力するためのクラス
'-----------------------------------------------------------------------------------------------------
' 呼び出し例
'
'クラスの場合
' Dim PL As PairLogger: Set PL = Constructor(New PairLogger, TypeName(Me) & ".FileSearchEx")
'
'標準モジュールの場合
' Dim PL As PairLogger: Set PL = Constructor(New PairLogger, "Module1.FileSearchEx")
'-----------------------------------------------------------------------------------------------------
Option Explicit
Implements IConstructor
Dim m_Msg As String
'----------------------------------------------------
' コンストラクタ
'----------------------------------------------------
Private Function IConstructor_Instancing(ByRef Args As Collection) As Object
    m_Msg = Args(1)
    Logger.LogBegin m_Msg

    Set IConstructor_Instancing = Me

End Function
'----------------------------------------------------
' デストラクタ
'----------------------------------------------------
Private Sub Class_Terminate()
    Logger.LogFinish m_Msg
End Sub

Power Query で UTF8 の CSV ファイルを読み込むVBAを作成しているのだが、
ファイルを固定にせず、VBAから渡せるようにしたい。
いろいろやってみると、M言語(Power Queryのやつ)を組み立てて、CSVファイルを受け渡してやればいい様子。

だいたい、VBAの文字列で他の言語を組み立てるって超めんどい。そのままM言語書けないものか。。。
というわけで、ちょっとそれっぽいクラスを作ってみた。
ちなみに、自分の必要な関数だけを追加しただけなので、本当にCSVの取り込みぐらいしかできません。
ただ、これから関数を増やしていければいいなぁ～と思っている。

以下、クラスが M言語の関数に対応する。そのままのクラス名は使えないので M + クラス名にしたら一か所に集まるし
いい感じになるかな。

MCsv ・・・ Csv の関数の入るクラス。
MFile ・・・ File の関数の入るクラス。
MTable ・・・ Table の関数の入るクラス。
MCommand ・・・ 各クラスからM言語を作り出すクラス

以下、Github にソースをアップ済みです。
https://github.com/RelaxTools/MFunctionCreater

使い方は以下を参照してたただくとわかると思うが、まんまM言語イメージで書けるのが売りです。

'------------------------------------------------
' MCommandをVBAで作成する場合のヘルパークラス
'------------------------------------------------
Sub Sample()

    '-----------------------------------
    ' MCommandを代入せずに作成する場合
    '-----------------------------------
    Dim t1 As MTable
    Dim t2 As MTable
    Dim t3 As MTable
    
    Set t1 = MCsv.Document(MFile.Contents("C:\Test.csv"), "Delimiter="",""", _
             "Columns=5", "Encoding=65001", "QuoteStyle=QuoteStyle.Csv")
    Set t2 = MTable.Skip(t1, 2)
    Set t3 = MTable.PromoteHeaders(t2, "PromoteAllScalars=true")

    Dim m1 As MCommand
    Set m1 = New MCommand
    
    m1.Append t3
    Debug.Print m1.ToString
    
    '結果
    'let Source1 = Table.PromoteHeaders(Table.Skip(Csv.Document(File.Contents("C:\Test.csv"),
    '              [Delimiter=",", Columns=5, Encoding=65001, QuoteStyle=QuoteStyle.Csv]), 2), 
    '              [PromoteAllScalars=true]) in Source1

    
    '-----------------------------------
    ' MCommandに代入して作成する場合
    '-----------------------------------
    Dim m2 As MCommand
    Set m2 = New MCommand
    
    m2.Append MCsv.Document(MFile.Contents("C:\Test.csv"), "Delimiter="",""", "Columns=5", _
              "Encoding=65001", "QuoteStyle=QuoteStyle.Csv")
    m2.Append MTable.Skip(m2.LastTable, 2)
    m2.Append MTable.PromoteHeaders(m2.LastTable, "PromoteAllScalars=true")

    Debug.Print m2.ToString

    '結果
    'let Source1 = Csv.Document(File.Contents("C:\Test.csv"), [Delimiter=",", 
    '              Columns=5, Encoding=65001, QuoteStyle=QuoteStyle.Csv]),
    '    Source2 = Table.Skip(Source1, 2),
    '    Source3 = Table.PromoteHeaders(Source2, [PromoteAllScalars=true]) in Source3

End Sub

テーブルを作成し、MCommand に追加していき、最後に .ToString メソッドでＭ言語の文字列を作成します。
文法上、VBAではできないようなものも出てきそうですが、全部のメソッドをサポートする気はないので、
使える部分でコツコツ追加していこうかと思います。

Interface で コンパレータを実装する。

クラス内のSortコマンドのソート順を変えたいケースが出てきました。
ソート方法を変更するパターンとして Java や C# でコンパレータを利用するパターンがあります。
それをVBAで実現してみた。と、いっても Object でもできちゃうのでアレですが Interface 好きなので。
（なお、この例ではクラス内のSortではなく、標準モジュールに書いています。念のため）

インターフェースの実装(IComparerクラス)

通常インタフェースの中身は必要ありませんが、規定の比較方法として後で使用します。

Option Explicit

Public Function Compare(ByVal v1 As Variant, ByVal v2 As Variant) As Long
    
    'defaultの比較方法
    Select Case v1
        Case Is > v2
            Compare = 1
        Case Is < v2
            Compare = -1
        Case Is = v2
            Compare = 0
    End Select

End Function

比較方法の中身を入れ替えるコンパレータ実装(ExplorerComparerクラス)

比較方法としてExplorerの比較方法をソートに導入します。

Option Explicit
Implements IComparer
Private Declare PtrSafe Function StrCmpLogicalW Lib "Shlwapi" (ByVal psz1 As LongPtr, ByVal psz2 As LongPtr) As Long

'Explorer と同様の比較を行うコンパレータ
Private Function IComparer_compare(ByVal v1 As Variant, ByVal v2 As Variant) As Long
    
    IComparer_compare = StrCmpLogicalW(StrPtr(CStr(v1)), StrPtr(CStr(v2)))

End Function

呼び出しサンプル

ソートの引数でコンパレータが指定されたときにその内容を使用してソートをします。
指定されなかった場合、IComparer クラス内に記述されて規定の比較方法でソートするようにします。

Option Explicit
Private mCol As Collection
'--------------------------------------------------------------
'  コレクションのソート
'--------------------------------------------------------------
Private Sub Sort(Optional ByVal CP As IComparer = Nothing)

    Dim i As Long
    Dim j As Long
    Dim col2 As Collection
    Dim blnFind As Boolean
    
    If CP Is Nothing Then
        'Interfaceも普通のクラスなのでDefault比較として利用
        Set CP = New IComparer
    End If
    
    'Collectionが空ならなにもしない
    If mCol Is Nothing Then
        Exit Sub
    End If

    'Collectionの要素数が０または１の場合ソート不要
    If mCol.Count <= 1 Then
        Exit Sub
    End If
    
    Set col2 = New Collection
    
    For i = 1 To mCol.Count
        If col2.Count = 0 Then
            col2.Add mCol(i)
        Else
            blnFind = False
            For j = col2.Count To 1 Step -1
    
                '元コレクションの方が大きかった場合、その後に挿入。
                If CP.Compare(mCol(i), col2(j)) >= 0 Then
                    col2.Add mCol(i), , , j
                    blnFind = True
                    Exit For
                End If
            Next
            If Not blnFind Then
                col2.Add mCol(i), , 1
            End If
        End If
    
    Next
    
    Set mCol = col2
    Set col2 = Nothing

End Sub
'--------------------------------------------------------------
'  IComparer サンプル
'--------------------------------------------------------------
Sub IComparer_Sample()

    Set mCol = New Collection

    mCol.Add "１"
    mCol.Add "２"
    mCol.Add "４"
    mCol.Add "１０"
    mCol.Add "６"
    mCol.Add "３"
    mCol.Add "７"
    mCol.Add "８"
    mCol.Add "５"
    mCol.Add "９"
    
    Dim v As Variant
    
    '通常のソート
    Call Sort

    For Each v In mCol
        Debug.Print v
    Next

    Debug.Print "-----------------------"
    
    'Explorerと同様のソート
    Call Sort(New ExplorerComparer)
    
    For Each v In mCol
        Debug.Print v
    Next

End Sub

結果

以下のようにソート順が変更されました。

１
１０
２
３
４
５
６
７
８
９
-----------------------
１
２
３
４
５
６
７
８
９
１０

最近はExploererの自然数ソートの方がしっくりくるパターンの方が多くなりましたね。

Interface で コンパレータを実装する。

クラス内のSortコマンドのソート順を変えたいケースが出てきました。
ソート方法を変更するパターンとして Java や C# でコンパレータを利用するパターンがあります。
それをVBAで実現してみた。と、いっても Object でもできちゃうのでアレですが Interface 好きなので。
（なお、この例ではクラス内のSortではなく、標準モジュールに書いています。念のため）

インターフェースの実装(IComparerクラス)

通常インタフェースの中身は必要ありませんが、規定の比較方法として後で使用します。

Option Explicit

Public Function Compare(ByVal v1 As Variant, ByVal v2 As Variant) As Long
    
    'defaultの比較方法
    Select Case v1
        Case Is > v2
            Compare = 1
        Case Is < v2
            Compare = -1
        Case Is = v2
            Compare = 0
    End Select

End Function

比較方法の中身を入れ替えるコンパレータ実装(ExplorerComparerクラス)

比較方法としてExplorerの比較方法をソートに導入します。

Option Explicit
Implements IComparer
Private Declare PtrSafe Function StrCmpLogicalW Lib "Shlwapi" (ByVal psz1 As LongPtr, ByVal psz2 As LongPtr) As Long

'Explorer と同様の比較を行うコンパレータ
Private Function IComparer_compare(ByVal v1 As Variant, ByVal v2 As Variant) As Long
    
    IComparer_compare = StrCmpLogicalW(StrPtr(CStr(v1)), StrPtr(CStr(v2)))

End Function

呼び出しサンプル

ソートの引数でコンパレータが指定されたときにその内容を使用してソートをします。
指定されなかった場合、IComparer クラス内に記述されて規定の比較方法でソートするようにします。

Option Explicit
Private mCol As Collection
'--------------------------------------------------------------
'  コレクションのソート
'--------------------------------------------------------------
Private Sub Sort(Optional ByVal CP As IComparer = Nothing)

    Dim i As Long
    Dim j As Long
    Dim col2 As Collection
    Dim blnFind As Boolean
    
    If CP Is Nothing Then
        'Interfaceも普通のクラスなのでDefault比較として利用
        Set CP = New IComparer
    End If
    
    'Collectionが空ならなにもしない
    If mCol Is Nothing Then
        Exit Sub
    End If

    'Collectionの要素数が０または１の場合ソート不要
    If mCol.Count <= 1 Then
        Exit Sub
    End If
    
    Set col2 = New Collection
    
    For i = 1 To mCol.Count
        If col2.Count = 0 Then
            col2.Add mCol(i)
        Else
            blnFind = False
            For j = col2.Count To 1 Step -1
    
                '元コレクションの方が大きかった場合、その後に挿入。
                If CP.Compare(mCol(i), col2(j)) >= 0 Then
                    col2.Add mCol(i), , , j
                    blnFind = True
                    Exit For
                End If
            Next
            If Not blnFind Then
                col2.Add mCol(i), , 1
            End If
        End If
    
    Next
    
    Set mCol = col2
    Set col2 = Nothing

End Sub
'--------------------------------------------------------------
'  IComparer サンプル
'--------------------------------------------------------------
Sub IComparer_Sample()

    Set mCol = New Collection

    mCol.Add "１"
    mCol.Add "２"
    mCol.Add "４"
    mCol.Add "１０"
    mCol.Add "６"
    mCol.Add "３"
    mCol.Add "７"
    mCol.Add "８"
    mCol.Add "５"
    mCol.Add "９"
    
    Dim v As Variant
    
    '通常のソート
    Call Sort

    For Each v In mCol
        Debug.Print v
    Next

    Debug.Print "-----------------------"
    
    'Explorerと同様のソート
    Call Sort(New ExplorerComparer)
    
    For Each v In mCol
        Debug.Print v
    Next

End Sub

結果

以下のようにソート順が変更されました。

１
１０
２
３
４
５
６
７
８
９
-----------------------
１
２
３
４
５
６
７
８
９
１０

最近はExploererの自然数ソートの方がしっくりくるパターンの方が多くなりましたね。

クラスに楽にデータを入れたい

レコードイメージのクラスを良く使う。そのクラスの中にその固有の処理をカプセル化していけばいいのだ。しかし、外部との連携はDictionary等に比べると面倒な感じ。

Person クラス

Option Explicit

Public Name As String
Public Age As Long
Public Address As String

以下のようなテーブルを Person クラスに設定することを考えます。

ふつうに追加するとこんな感じ

Sub TableToPersonClass()
    
    'Person Class にコピー
    Dim col2 As Collection
    Set col2 = New Collection
    
    Dim c As Person
    Dim LO As ListObject
    Set LO = ActiveSheet.ListObjects(1)
    
    Dim i As Long
    Dim j As Long
    
    For i = 1 To LO.DataBodyRange.Rows.Count
            
        Set c = New Person
        'ベタに書くしかない
        c.Name = LO.DataBodyRange.Cells(i, 1).Value
        c.Age = LO.DataBodyRange.Cells(i, 2).Value
        c.Address = LO.DataBodyRange.Cells(i, 3).Value
    
        col2.Add c
    
    Next
    
    For Each c In col2
        Debug.Print c.Name
        Debug.Print c.Age
        Debug.Print c.Address
    Next
    
End Sub

列が増えればその分記入も増えて大変。このへんいつもめんどうだとおもっていました。

CallByNameの出番

今頃気が付きましたが、CallByName を使用すればシームレスに値のコピーが可能です。テーブルの列名を合わせておけば項目名を意識せずに処理可能です。

Sub TableToPersonClass()
    
    'Person Class にコピー
    Dim col2 As Collection
    Set col2 = New Collection
    
    Dim c As Person
    Dim LO As ListObject
    Set LO = ActiveSheet.ListObjects(1)
    
    Dim i As Long
    Dim j As Long
    
    For i = 1 To LO.DataBodyRange.Rows.Count
            
        Set c = New Person
        
        For j = 1 To LO.HeaderRowRange.Columns.Count
        
            'Person Class
            CallByName c, LO.HeaderRowRange(, j).Value, VbLet, LO.DataBodyRange.Cells(i, j).Value
        
        Next
    
        col2.Add c
    
    Next
    
    For Each c In col2
        Debug.Print c.Name
        Debug.Print c.Age
        Debug.Print c.Address
    Next
    
End Sub

Dictionaryからのシャローコピーにも使える。

Sub DictionaryToPerson()

    Dim dic As Scripting.Dictionary
    
    Set dic = New Scripting.Dictionary
    
    dic.Add "Name", "watanabe"
    dic.Add "Age", 48
    dic.Add "Address", "千葉県"
    
    Dim v As Variant
    Dim c As Person
    
    Set c = New Person
    
    For Each v In dic.Keys
        CallByName c, v, VbLet, dic.Item(v)
    Next

    Debug.Print c.Name
    Debug.Print c.Age
    Debug.Print c.Address

End Sub

JSONからのパースにも使えるのでデシリアライズがはかどる～