指定セル範囲からDictionaryオブジェクトを作成する

引数に指定したセル範囲のデータを取得したDictionaryオブジェクトを作成する関数です

Function zzz辞書作成(ByVal hzzセル範囲 As Range, Optional ByVal hzzオフセット列数 As Long = 0) As Object
Dim zz辞書 As Object: Set zz辞書 = CreateObject("Scripting.Dictionary")
Dim zz対象セル As Range


For Each zz対象セル In hzzセル範囲
    If zz対象セル <> "" Then
        If zz辞書.Exists(zz対象セル.Text) = False Then
            zz辞書.Add zz対象セル.Text, zz対象セル.Offset(0, hzzオフセット列数).Text
        Else: End If
    Else: End If
Next zz対象セル

If zz辞書.Count <> 0 Then
    Set zzz辞書作成 = zz辞書
Else: End If
Set zz辞書 = Nothing


End Function

コード中にある辞書とは、Dictionaryオブジェクトのことになります
これを使用すると、作成したリストから特定のkeyプロパティに対応するitemプロパティを取得することが出来ます
Dictionaryオブジェクトについては以下の記事で解説しています

ですが、これを作成する場合は、インスタンスの作成からデータの取得までを行う必要があります
これが作成のたびに作るのが案外面倒なので処理化しました

この関数を実行すると、引数に指定したセル範囲のデータからDictionaryオブジェクトのリストを作成して、そのDictionaryオブジェクトを返します
なお、取得したアイテムが無ければNothingを返します

目的とは少し違ってきますが、Dictionaryオブジェクト自体が重複不可なリストを作成しますので、セル範囲のデータから重複しないデータのリストを作成することも可能です

なお、この関数では取得するデータは全て文字列として取得されます

関数の書式

引数(太字は必須引数)
(hzzセル範囲, hzzオフセット列数)
戻り値の型 Object型

「hzzセル範囲」は取得を行うセル範囲を指定します
いちおう複数列は指定可能ですが、次のオフセット列数を指定する場合はその分列がずれていく点には注意が必要です

「hzzオフセット列数」は指定したセル範囲のデータをitemとして取得するかどうかを設定するための数値です
引数に指定したセル範囲のデータをitemとして取得してよければ省略してください
オフセット数値なので負の数値も設定可能ですが、指定セル範囲から参照できない数値を指定した場合は実行時エラーが発生します

関数の使用例

Dim zz辞書 As Object
Set zz辞書 = zzz辞書作成(Range("A2:A10"), 1)
If zz辞書 Is Nothing Then
Exit Sub
Else: End If

Dim zz取得キー As Variant
For Each zz取得キー In zz辞書.Keys
Debug.Print zz辞書(zz取得キー)
Next zz取得キー

実際に使用する場合は、戻り値を代入させる変数の宣言を行っておく必要があります
また、この変数の型は戻り値の型がObject型なので合わせておいてください

引数には指定セル範囲がA1~A10までの10個のセルを指定
オフセット数値に1を指定していますので、itemはB1~B10の内容が取得されることになります

セル範囲をB1~B10にして、数値を-1に指定すれば、B列がkeyとなりA列がitemとなるDictionaryオブジェクトの作成が可能です

上記に記載しましたが、この関数は取得したアイテムの数は0個の場合にはNothingを返しますので、その判定を一応行っています
その場合には処理を終了しています

取得が出来ていれば、そのitemを全てイミディエイトに出力しています
実際の処理時には、すべてをループするような処理よりはExistsメソッドを使用して必要なitemを検索取得するような流れになる場合が多いと思います
Existsメソッドについては以下の記事を確認してください

また、ここでは全てを紹介しきれないのでコード自体は割愛しますが、この関数は上記でも解説したように全てが文字列として取得されていますので、keyから取得するitemも全て文字列で返されます
なので、日付や数値などを利用する場合はその型に変換して取得させるようにしてください
比較を行う場合は、逆にそれらを文字列型に変換してから比較するようにします

コード解説

Function zzz辞書作成(ByVal hzzセル範囲 As Range, Optional ByVal hzzオフセット列数 As Long = 0) As Object

~~中略~~

End Function

戻り値として、作成したDictionaryオブジェクトを返すのでFunctionプロシージャとして作成をしています
また、返すのはDictionaryオブジェクトですがバインディングが必要な型になるので、汎用的なObject型として指定しています

そのため、この関数の戻り値を代入させる変数も同じ型にしておいてください

Dim zz辞書 As Object: Set zz辞書 = CreateObject("Scripting.Dictionary")
Dim zz対象セル As Range

関数内で使用する変数の宣言です
使用する変数は2つになります

1つ目はDictionaryオブジェクトです
事前バインディングは行わず、実行時バインディングを行っています
なので、変数の型はObject型となります
変数の宣言後、すぐにインスタンスの作成を行っています
特に処理の実行条件確認は行っていないためです

2つ目は引数のセル範囲をループさせるためのセル変数です

For Each zz対象セル In hzzセル範囲

~~中略~~

Next zz対象セル

引数のセル範囲を全てループします
セルはオブジェクトなので、For Eachループを使用してすべてのセルを1つ1つ参照していきます

    If zz対象セル <> "" Then

~~中略~~

    Else: End If

セルの入力値が空白であれば取得は行いません
そもそも空白のデータというものが、空白というデータなのかデータが無いというのかを判定するのは面倒ですし、何より引数に指定するセル範囲に空白が存在しないようにするもの面倒です

なので、前提として空白は取得を行いません

        If zz辞書.Exists(zz対象セル.Text) = False Then
            zz辞書.Add zz対象セル.Text, zz対象セル.Offset(0, hzzオフセット列数).Text
        Else: End If

次にDictionaryオブジェクトにデータを取得させるには、すでに存在するkeyは取得できないので、データの存在確認を行います
ExistsメソッドによりFalseが返された場合にのみ取得を行います

取得する際にkeyはループ参照しているセルのTextプロパティを取得させます
keyは代入させられる型がセルほどにありません
文字列と数値で同じ見た目でも別の値と認識されて、itemが取得できなくなるので前提として統一しておいた方が後で取り出しやすくなります
なので、この関数では全てのデータは文字列として取得させています

itemは参照セルからオフセット数値を列移動させたデータを取得させます
オフセット数値が省略時は0が指定されるので、移動しないので参照セルを取得する形になります
つまりkeyとitemが同じものが取得されることになります
こちらもkey同様にTextプロパティを取得しています

If zz辞書.Count <> 0 Then
    Set zzz辞書作成 = zz辞書
Else: End If
Set zz辞書 = Nothing

指定セル範囲からリストの作成が完成したら、最後にそのDictionaryオブジェクトをFunctionプロシージャの戻り値に設定します

しかし、そもそもitemが全くないDictionaryオブジェクトを返しても意味は無いので、item数をCountプロパティから取得してその個数が0でなければ戻り値に代入します

0であれば戻り値に代入しませんので、Object型の初期値であるNothingが返されることになります

これで、この関数の戻り値がNothingかどうかを判定することでitemの有無を判定させることが出来ます

最後に使用したObject型変数の解放を行っています

この関数を使用すれば、Dictionaryオブジェクトを使用する際にインスタンスの作成を自分で作成する必要が無いので文字列型で問題なければ有効に利用できます

開かれているブックから指定したシートを取得する

全てのブックの全てのシートから指定した名称のシートを1つ取得する関数です

Function zzzワークシート取得(ByVal hzz検索文字列, Optional ByVal hzzCN検索 As Boolean = False) As Worksheet
Dim zz対象Bk As Workbook, zz対象Sh As Worksheet, zz取得Sh As Worksheet


For Each zz対象Bk In Application.Workbooks
    For Each zz対象Sh In zz対象Bk.Worksheets
        If hzzCN検索 = True Then
            If zz対象Sh.CodeName Like hzz検索文字列 Then
                Set zz取得Sh = zz対象Sh: Exit For
            Else: End If
        Else
            If zz対象Sh.Name Like hzz検索文字列 Then
                Set zz取得Sh = zz対象Sh: Exit For
            Else: End If
        End If
        If Not zz取得Sh Is Nothing Then
            Exit For
        Else: End If
    Next zz対象Sh
Next zz対象Bk
Set zz対象Sh = Nothing
Set zz対象Bk = Nothing

If Not zz取得Sh Is Nothing Then
    Set zzzワークシート取得 = zz取得Sh
    Set zz取得Sh = Nothing
Else: End If


End Function

開かれているブックの中から指定の名称のシートを取得する関数です
この関数は引数に指定した文字列に完全に一致するシートをオブジェクトで返します

シートオブジェクトにはVBAでのみ扱うオブジェクト名というものが存在します
CodeNameプロパティを使用することで取得できます
この名称でも検索を行えるようにしています、その場合は2つ目の引数にTrueを指定してください

関数の書式

引数(太字は必須引数)
(hzz検索文字列, hzzCN検索)
戻り値の型 Worksheet型

「hzz検索文字列」は、検索を行う際のシート名、もしくはオブジェクト名を文字列で指定します
完全一致での検索になるので、検索したい名称のすべてを指定するようにします

「hzzCN検索」は、検索方法の設定です
Trueを指定すると、オブジェクト名で検索します
Falseを指定すると、シート名で検索を実行します
省略が可能で、省略時はFalseが指定されます

関数の使用方法

Dim zz対象Sh As Worksheet
Set zz対象Sh = zzzワークシート取得("Sheet1")
If zz対象Sh Is Nothing Then
Exit Sub
Else: End If

zz対象Sh.Range("A1") = 1000
zz対象Sh.Parent.Save

実際に使用する場合は、返し値のある関数なので代入先を作成してから使用します
今回で言えば、「zz対象Sh」というWorksheet型の変数を作成してそこに代入させています

さらに、この関数は検索が見つからなかった場合はNothingが返されるので関数の後に判定を行う必要があります
もし取得できていなかった場合は実行時エラーが発生するからです

その際にはオブジェクトの比較をIs演算子で行います

オブジェクトの取得が完了していれば、処理を実行します
今回の処理では、A1セルに「1000」を入力してから、ブックの上書き保存を実行しています

このシートからの指定の最大の利点がアクティブを遷移させる必要が無いため、処理の高速化が図れる点です
シートの切り替えを行わずにバックグランドで処理を実行すれば画面更新の抑止も全く必要なくなります
セル選択を減らすことが処理の高速化につながりますが、さらにシート・ブックまでも選択を減らすことでさらに改善できます

また、Parentプロパティを使用することでブックの指定を行うことも可能なのでブックに対する処理も取得したオブジェクトで実行することが出来ます
あまり分かりやすいとは言えないので、せいぜいこの程度の処理で行うと良いです
Parentプロパティを経由すれば別のシートの操作も可能ですが、あまりしない方が良いですね

コード解説

Function zzzワークシート取得(ByVal hzz検索文字列, Optional ByVal hzzCN検索 As Boolean = False) As Worksheet

~~中略~~

End Function

引数を2つ使用する関数の作成です
取得したワークシートを返すので、関数の返し値の型はWorksheet型に指定しています
最後のEnd Functionまでが処理の中身になります

Dim zz対象Bk As Workbook, zz対象Sh As Worksheet, zz取得Sh As Worksheet

変数の宣言です
「zz対象Bk」はWorkbook型で、この関数の処理では開かれているすべてのブックを参照するので、そのループ処理に使用します

「zz対象Sh」と「zz取得Sh」はWorksheet型です
対象Shはループ用の変数で、取得Shは検索文字列と一致するものを見つけた時の代入先です

For Each zz対象Bk In Application.Workbooks
    For Each zz対象Sh In zz対象Bk.Worksheets

~~中略~~

    Next zz対象Sh
Next zz対象Bk
Set zz対象Sh = Nothing
Set zz対象Bk = Nothing

ここでは2つのオブジェクトループを行っています
1つ目が開かれているブック全てのループです
Application.WorkbooksはExcelが開いているブック全てを返すプロパティです

ここで1つ注意点として、このApplicationというのはVBAが実行されているブックを開いているExcelという意味になります
実際、Excelは複数起動することが可能です
単純にExcelブックを開いただけならExcelが複数起動することは無く、Excelの中でブックが複数開かれる状態になります

もし、あえて複数起動を行っている状況であれば少し複雑な処理になってきますので、ここでは割愛しますが、複数起動されていても同様の目的の処理を作成することは可能です

次に、その1つ1つのブックのシートのループです
zz対象Bk.Worksheetsというのは、1つ目のブックループで取得された1つのブックの中のすべてのシートを返すプロパティです
これですべてのブックのすべてのシートをループさせることが出来ます

オブジェクトループはループが終了すると代入変数は解放されます
しかし、今回の処理では目的のものが見つかった時点でループを最後まで実行せず途中で強制終了します
その場合は、変数が解放されません

そのため、ループを抜けた後に変数をそれぞれ解放しています

        If hzzCN検索 = True Then
            If zz対象Sh.CodeName Like hzz検索文字列 Then
                Set zz取得Sh = zz対象Sh: Exit For
            Else: End If
        Else
            If zz対象Sh.Name Like hzz検索文字列 Then
                Set zz取得Sh = zz対象Sh: Exit For
            Else: End If
        End If

シートのループまで実行して、1枚のシートが取得されたら
そのシートの名前もしくはオブジェクト名が指定のものかどうかを判定します

その判定基準が引数で指定されたものになるので、まずはhzzCN検索がTrueなのかどうかで処理を分岐します

もしTrueであればオブジェクト名で判定を行うことになります
オブジェクト名はCodeNameプロパティを使用することで取得できます
このプロパティは取得専用です

またFalseであった場合はNameプロパティを使用して判定します
Nameプロパティはシートの見出しに表示されている文字列なのでユーザーが認識しているシートの名前です

この2つのプロパティはどちらが良いというものでは無いので、関数としてどちらも検索を行えるようにしました
あえてこの2つを並列に検索するようなことはしていませんが、もしいずれかにでも指定文字列が含まれるかを調べる関数にしたい場合はここの処理分岐を無くせば可能です

                Set zz取得Sh = zz対象Sh: Exit For

そしてどちらにしても、検索文字列と一致するものであった場合は取得変数に代入してループを抜けます

特に意味は無いのですが、ここでは「:」を使用して処理を1行に収めています

        If Not zz取得Sh Is Nothing Then
            Exit For
        Else: End If

シートのループが終了もしくは抜けてきたら、zz取得Shが代入済みかを判定します
この時点で代入済みであればブックのループももう必要ないのでループを抜けます

シートが見つかった時点でGotoを使用すれば一気にブックループも抜けられますが、基本的にそういった処理の組み方はお勧めできません
変数の型によってはロックしたりしてしまいます

ループの個数分、しっかり終了させるようにしてください

If Not zz取得Sh Is Nothing Then
    Set zzzワークシート取得 = zz取得Sh
    Set zz取得Sh = Nothing
Else: End If

最後に、ブックのループを終了もしくは抜けてきた場合にzz取得Shが代入済みかを判定します
ここで代入済みであれば、その代入されたオブジェクトを返し値に設定します
それが済めばzz取得Shは解放します

この1つ前の処理で、全く同じ条件式でIf分岐が存在していますが、そちらはあくまでもブックのループを終了させるかどうかの判定用です
こちらとは目的が違っているので、同じ条件式ならまとめてしまっていいじゃないの~と感じるかもしれませんが、そこは丁寧にコーディングしてあげてください

この関数を使用すれば、別ブックのシートなどをいちいちブック指定から行う必要がなくなるので非常にコードがスッキリします
最近は処理の最前にこの関数があるのが当たり前になってきましたので、実際に使い慣れてくるとめちゃめちゃ便利です

配列を並び替え(昇順・降順)する関数

Worksheetのソート機能を利用して配列を並び替えする関数

Sub zzz配列並替(ByRef zzh指定配列 As Variant, Optional zzh降順 As Boolean = False)
    Application.ScreenUpdating = False
    Dim zzループ用 As Variant, zz配列要素数 As Long
    Dim zzCell As Range: Set zzCell = Workbooks.Add.Worksheets(1).Range("A1")
    For Each zzループ用 In zzh指定配列
        zzCell = zzループ用
        Set zzCell = zzCell.Offset(1, 0)
    Next zzループ用
    Set zzCell = zzCell.Offset(-1, 0)
    If zzh降順 = False Then
        Range(zzCell.Parent.Range("A1"), zzCell).Sort zzCell, xlAscending
    Else
        Range(zzCell.Parent.Range("A1"), zzCell).Sort zzCell, xlDescending
    End If
    zz配列要素数 = LBound(zzh指定配列)
    For Each zzループ用 In Range(zzCell.Parent.Range("A1"), zzCell)
        zzh指定配列(zz配列要素数) = zzループ用
        zz配列要素数 = zz配列要素数 + 1
    Next zzループ用
    zzCell.Parent.Parent.Close False
    Set zzCell = Nothing
    Application.ScreenUpdating = True
End Sub

配列データはそのままでは並び替えを行えません
一度分解して、配列を再作成する必要があります
配列を昇順・降順の指定をして並び替えを実行する関数です

この関数はワークシートのソート機能を利用しています
ワークシートを新規作成してそこにデータを一度出力して並び替えをしています
なので、ワークシートを作成する処理時間が余分にはかかりますが、なんせデータ型への対応が柔軟なので汎用処理に向いています

この関数を使用する際に注意点があります
この関数では配列データをそのままセルに入力して取得しなおすだけの処理でありデータの型を認識していません
そのため、文字列データとしてある数値の場合に頭文字の0が抜けることがあります
「0123」→「123」という形に振り替えられます
これはExcelの仕様上の部分でもありますが、型を事前に取得して文字列として扱えば対応は可能です
もし、そういったデータを扱う際は少し改修して使用する必要があります
これに関しては、あまり遭遇しなかったので必要性が高そうなら改修コードを掲載しようとは思います

関数の書式

引数(太字は必須引数)
(zzh指定配列, zzh降順)

「zzh指定配列」は、並び替えを実行したい配列データを指定します
必須項目でここに指定した配列を加工します

「zzh降順」は、並び替えの順序の指定です、省略可能で省略時はFalseになります
Falseの場合は昇順に、Trueの場合は降順に並び替えされます

コードの使用方法

Call zzz配列並替(セル配列)

SubプロシージャなのでCallステートメントを使用して処理を呼び出します
その際引数には指定配列を指定します、2つ目の引数は省略しているのでこのコードの場合は配列は昇順に並び替えが実行されます

データ加工前の配列データ
加工前の配列データ

加工を行う前の数値で作成された配列データです
これを関数を使用して並び替えを行います

配列データを関数を使用して昇順に並び替えた状態
関数を実行した状態

上記のコードを実行して配列データが昇順に並び替えられた状態のデータです
昇順なので数字の小さいものから順番に並んでいることが確認できます

ただ、これだけならわざわざワークシート機能を利用しなくても出来ます
そのほうが遥かに高速に処理できます
それは数値を加工するからです、これを文字列も含むとなるとやっかいです
まして同じ関数内にそれを組み込むとなると大変です

複雑なデータ型になっている配列データ
いろいろなデータ型の配列

画像を確認してください、特に3列目の型の部分です
Valiant型ですが、内部的にはバラバラの型になっていることが分かります

これを数値の並び替えでは対応できませんし、数値専用・文字列専用の関数を別に作成するのも使用するのも面倒なのでワークシート機能を利用するのが結果楽になります

複雑な配列データを関数を使用して昇順に並び替えた状態
昇順に並び替えた状態

この画像は関数を使用して昇順に並び替えた状態のデータです
型ごとに昇順に並んでいることが確認できます

これは単にワークシートのソート機能を1回実行しているだけで可能です
この並び替え処理をVBAで書いたら、いったいどれだけのコードになるのか分かりません
Microsoftの開発者さんの凄まじさが良くわかります

複雑な配列データを関数を使用して降順に並び替えた状態
降順に並び替えた状態

関数の2つ目の引数にTrueを指定して降順に並び替えた状態です
こちらも型ごとにしっかり並び変わっていることが確認できます

Call zzz配列並替(セル配列, True)

こんな感じで2つ目の引数は省略せずにTrueを指定してください

こんな無茶苦茶な配列データなんか、ねえよ!ってのも聞こえてきますが、というか自分自身がなにより思いますが、このソート機能の凄まじい処理能力のためなら、少しの処理時間は犠牲にしてもええんちゃいますか?だめですか?

自分の環境では配列データ数が1000で0.2秒ほど、10000で0.5秒ほどです
処理がこれだけではなく組み込んで、他の処理もあることを考えても実用レベルかなとは思います

コード解説

Sub zzz配列並替(ByRef zzh指定配列 As Variant, Optional zzh降順 As Boolean = False)

~~ 中略 ~~

End Sub

関数のプロシージャ範囲です
この関数は引数の配列データを加工する関数なのでSubプロシージャで作成しています

引数は2つあります

「ByRef zzh指定配列 As Variant」は、関数で加工を行う配列の引数です
この配列データを加工するのでByRefキーワードを使用しています
これによりこの関数で行った加工を呼び出し元に戻すことが出来ます
また配列データなのでValiant型です

「Optional zzh降順 As Boolean = False」は、関数で使用する並び替え順序の指定を行う引数です
この引数はOptionalキーワードを使用していますので省略可能です
省略した場合はFalseが指定されます
Falseを指定した場合は昇順に、Trueを指定した場合は降順に並び替えます
フラグなのでBoolean型です

    Application.ScreenUpdating = False

この関数はすでに触れましたが、ワークブックを新規作成します
その処理上どうしてもその新規作成したものにフォーカスが移ってしまうので、画面遷移が発生しますので、処理速度向上のためにここで画面遷移を無効にします

    Dim zzループ用 As Variant, zz配列要素数 As Long

使用する変数の宣言箇所です、使用する変数は3つあります

「zzループ用 As Variant」は、指定した配列データをForループを実行する際に代入させる変数です
配列を代入させるのでValiant型になっています

「zz配列要素数 As Long」は、配列の要素数を指定する際の整数変数です
並び替えを実行した後に、配列を更新する際に使用します

    Dim zzCell As Range: Set zzCell = Workbooks.Add.Worksheets(1).Range("A1")

3つ目の変数は、宣言と同時に代入しているので1行が長くなっています

「zzCell As Range」は、新規作成したワークブックのA1セルを代入する変数です
このセルに配列データを入力していきます
新規作成した時点でのフォーカス移動は仕方ありませんが、ここで変数に代入させておくことで選択をしなくてもコードが分かり易くなるので変数を利用します

その後の後半部分が、ワークブックを新規作成してそのシートとセルを一括で指定しています
Addメソッドで完結してから、セルを代入させることもできますが、その場合ブックの指定がActivebookオブジェクトやらを使用する必要があるので、この1行が理解できるならこの方がスマートなコードになります

    For Each zzループ用 In zzh指定配列
        zzCell = zzループ用
        Set zzCell = zzCell.Offset(1, 0)
    Next zzループ用

指定した配列データを1要素ずつ全てをループしています
なので多次元配列であっても対応は可能ですが、ここから1次元配列として生まれ変わってしまいます

「zzCell = zzループ用」の箇所でセルに配列データを入力しています

「Set zzCell = zzCell.Offset(1, 0)」は1つ下のセルにセル変数を移動させています
これで改行を行っているような形です

    Set zzCell = zzCell.Offset(-1, 0)

ループが終了したら、セル変数を1つ上に移動させます
というのも、ここまででデータ全てを入力したあと改行しているので、データからはみ出した空白のセルが参照されている状態です

この後でデータの最下部を必要とするので、そこにセル変数を移動させておく必要があります

    If zzh降順 = False Then
        Range(zzCell.Parent.Range("A1"), zzCell).Sort zzCell, xlAscending
    Else
        Range(zzCell.Parent.Range("A1"), zzCell).Sort zzCell, xlDescending
    End If

ここで並び替えを実行しています
ワークシートのソート機能を実行しているだけです

「If zzh降順 = False Then」の部分で分かるように、引数の変数の指定によって処理を分岐させています

処理自体は上記にあるようにソートをかけているだけです
その際、セル範囲を指定して実行していますが、他にデータがある訳でもないのでどっちでもええっちゃええですね

    zz配列要素数 = LBound(zzh指定配列)

配列の下限数を取得しています

配列の個数は変わらないので要素数を再定義する必要はありません
ですが下限値は0とは限らないため、元々の下限値に合わせておく必要があります
下限値が合えば個数が変わらないため上限値も同時に確定するので、そちらは特に取得する必要はありません

    For Each zzループ用 In Range(zzCell.Parent.Range("A1"), zzCell)
        zzh指定配列(zz配列要素数) = zzループ用
        zz配列要素数 = zz配列要素数 + 1
    Next zzループ用

この箇所では並び替えを実行したセル範囲を1セルずつループにより元配列データに上書きをしていきます

その際の要素数の指定は先ほど取得していた下限値から始めていきます
元の配列データの中身に上書きしたら、要素数を更新してループを行います

    zzCell.Parent.Parent.Close False

配列の加工が終了したら新規作成したワークブックを閉じます

ここまでではブックの取得は行っていません、セルの取得のみです
しかしそのセルは対象のブック内のオブジェクトです

「Parent」プロパティを使用することで上位のオブジェクトを指定できます
ここでは2回連続で指定されています
これは、1回目のParentがワークシートになります、2回目がその上位のオブジェクトとなりワークブックが指定されます

このプロパティをもう1回連結すると、Excelを指定することができます

ワークブックのCloseメソッドを実行してブックを閉じますが、セルを編集しているため保存確認が表示されてしまうのでそれを回避するために、メソッドの引数にFalseを指定します
この指定を行うと、ブックが保存済みのステータスになるので終了時に確認が表示されなくなります

    Set zzCell = Nothing
    Application.ScreenUpdating = True
End Sub

最後にセル変数の解放と画面遷移を無効にしていた設定を元の有効な設定に戻します

少し回りくどいかもしれませんが、数値でも文字列でも対応できる柔軟さを考えるとこんな感じでExcelの機能を有効利用した方がええよね~

配列データを重複を除外して再作成する関数

配列データを重複しない配列データに加工する関数

Sub zzz重複除外(ByRef zzh指定配列 As Variant)
    Dim zz配列_Loop As Variant, zz作成配列() As Variant, zz配列要素数 As Long, zz判定辞書 As Object
    If IsObject(zzh指定配列) = True Then
        Err.Raise (13)
        Exit Sub
    Else: End If
    Set zz判定辞書 = CreateObject("Scripting.Dictionary")
    For Each zz配列_Loop In zzh指定配列
        If zz判定辞書.Exists(zz配列_Loop) = False Then
            zz判定辞書.Add zz配列_Loop, zz配列_Loop
            ReDim Preserve zz作成配列(zz配列要素数)
            zz作成配列(zz配列要素数) = zz配列_Loop
            zz配列要素数 = zz配列要素数 + 1
        Else: End If
    Next zz配列_Loop
    Erase zzh指定配列
    zzh指定配列 = zz作成配列
End Sub

配列データに一括でデータを取得した後に、そのデータから重複データを削除してユニークなリストを作成する場合に使用する関数です

この関数はユニークではないデータを加工する関数なので、オブジェクト型では実行できません
オブジェクトはそれ自体がユニークな存在なのでそもそも意味がありません

関数の書式

引数(太字は必須引数)
(zzh指定配列)

「zzh指定配列」は、重複を除外したいリストの配列データです
配列データなのでValiant型になります
後述しますが、オブジェクトの代入自体は可能ですが関数内でエラーが発生します

コードの使用方法

Dim zz1次元 As Variant
zz1次元 = Array(4, 1, 6, 3, 6, 7, 9, 7, 5, 4, 2, 2, 3, 7, 8, 8)
Call zzz重複除外(zz1次元)

このコードでは配列の変数宣言を行い、その変数に1次元配列として適当に入力した数値を代入しています
所々、数値がかぶっているのが確認できると思います

その代入後に、その配列データを重複を除外するようにしたい場合に関数を使用します、SubプロシージャになりますのでCallステートメントを使用して引数に配列データを指定して実行してください

関数を使用して重複が除外された配列データ
関数を実行した配列データ

画像を確認してください
この画像の上側にある青くなっている行の部分からが最初に作成された配列データです
要素のいくつかがかぶっているものがあるのが確認できると思います

次に画像下部の赤枠内のデータが関数を使用して重複したデータを除外した配列データになります
同じ数値が要素内に存在していないことを確認してください

これが関数が完了後に引数に指定した配列がデータが振り替わります
例コードでいくと、「zz1次元」が赤枠内の配列データに振り替わる形になります

はい、確認して皆さんふと思いませんでしたかね
重複してないけど順番ぐちゃぐちゃやん、と
そんなあなたにお送りする記事が以下にあります、また見てね

コード解説

Sub zzz重複除外(ByRef zzh指定配列 As Variant)

~~ 中略  ~~

End Sub

ここの関数はSubプロシージャになります
この処理の目的として、元々ある配列データから重複しないリストを作成したい場合に使用します

つまり、元々の配列データがその後の処理に必要な前提がほぼありません
なので、この関数でその元配列を加工するほうが目的に即しています

なので、ここでは引数を1つ設定しています
「zzh指定配列」は配列データを代入されるのでValiant型です
また、この引数の配列を加工して戻すので配列変数自体を受け取る必要があるのでByRefキーワードを使用しています
これにより参照渡しとなり、この関数内で行った加工を呼び出し元に戻すことができます

    Dim zz配列_Loop As Variant, zz作成配列() As Variant, zz配列要素数 As Long, zz判定辞書 As Object

プロシージャで使用する変数の宣言です
このプロシージャでは、3つの変数を使用します

「zz配列_Loop」は、Forループで引数の配列を1要素ずつ検証するための変数です
配列データを代入するのでValiant型です

「zz作成配列()」は、実際に作成する配列データです、重複している件数が初期時点で分からないため、動的配列でかつ都度要素数の再定義を行う必要があります
配列なのでValiant型です

「zz判定辞書」は、Dictionaryオブジェクトを代入する変数です
この重複検証にはいろいろ方法がありますが、DictionaryオブジェクトのExistsメソッドを使用するのが一番コードが分かり易いです
ここでもリストは作成していく形になりますが、あくまでも重複の検証判定用なのでデータとしては使用しません
実行時バインディングを行いますのでObject型です

    If IsObject(zzh指定配列) = True Then
        Err.Raise (13)
        Exit Sub
    Else: End If

ここでは引数に指定された配列データがObject型かどうかを判定しています
上記でも少し解説していますが、Object型はいわゆるRangeであったりするものです
これはそもそもがユニークな存在であり、重複しているものではありません
「Range(“A1”)」がワークシートの数だけ存在する、と思うかもしれませんが、実際の所、Excelからの指定が省略されているにすぎません
Addressプロパティが同じ、というだけに過ぎない訳です

なので、ユニークなリスト作成にそもそもオブジェクトは論外なのです

と、ごちゃごちゃ言いましたがこのIsObject関数がTrueを返せば、Object型になるので処理は行いません

その際実行時エラーを発生させています
それが「Err.Raise (13)」という箇所で、エラー13番を発生させるコードです
13番は型の不一致のエラーです、既存のものを使用しています

    Set zz判定辞書 = CreateObject("Scripting.Dictionary")

ここはDictionaryオブジェクトのインスタンスの作成です
DictionaryオブジェクトはVBAの標準機能ではありません
そういったものを利用する際はこのようにインスタンスの作成を行う必要があります
このコードの動きを実行時バインディングといいます
このあたりは以下の記事で解説していますので確認してください

    For Each zz配列_Loop In zzh指定配列

~~ 中略 ~~

    Next zz配列_Loop

配列の1要素ずつのForループです
ここで指定された配列の全ての要素を検証しています

全ての要素を検証するので、次元数は問いません
2次元であったとしても全て1要素ずつ検証できるので、多次元配列を処理することは可能です
ですが、出力は1次元配列なのでそこに問題が無ければ、という前提にはなります

        If zz判定辞書.Exists(zz配列_Loop) = False Then

~~ 中略 ~~

        Else: End If

重複の検証を行う箇所です

DictionaryオブジェクトのExistsメソッドを使用することでデータがオブジェクトに存在するかを検証しています

ここで存在が無い(Falseが返される)なら、Dictionaryオブジェクトと作成する配列にデータを取得させることになります
存在がある(Trueか返される)なら、何もせず次の要素の検証を行います

             zz判定辞書.Add zz配列_Loop, zz配列_Loop

まず、Dictionaryオブジェクトにデータの取得を行います
ここで取得を行うことで次に検証する材料を整えることが出来ます

            ReDim Preserve zz作成配列(zz配列要素数)
            zz作成配列(zz配列要素数) = zz配列_Loop
            zz配列要素数 = zz配列要素数 + 1

ここで作成する配列への取得を行っています

作成する配列は要素数が未確定のため都度再定義する必要があります
「ReDim Preserve」を使用することによって動的配列の要素数の再定義を行っていますが、その際に元々取得済みのデータは保持されます

要素数の再定義が完了したら、その要素数にデータを代入させます
そして次の要素数の再定義を可能にするために、要素数変数の更新を行っています

    Erase zzh指定配列
    zzh指定配列 = zz作成配列
End Sub

最後に引数配列に作成した配列を代入します
その際、引数配列はEraseステートメントを使用して一旦初期化します

初期化したのち作成配列のデータをそのまま代入させます
これでこの関数が完了し、呼び出し元では引数に指定した配列データが加工済みになっている状態になります

最後にこの関数の使用上の注意点として、数値の「1」と文字列の「1」はそれぞれをユニーク値として判定します

これは解説したように、判定方法がDictionaryオブジェクトのExistsメソッドを使用していることに起因します
このメソッドがそういった仕様になっています

ですが、セルをそのまま取得したようなデータでない限り問題は無いはずです
それに配列の中でそういった型の違うデータを重複しているとするかしないかはその時の処理次第な場合が多いような気もします

結局、数値と文字列で重複を判定したとしてもどちらを取得するかは、その処理次第ということです

セル範囲データを1次元配列化する関数

指定したセル範囲のデータを1次元配列として作成する関数

Function zzzセル範囲1次元配列化(ByVal zzhセル範囲 As Range, Optional zzhText取得 As Boolean = False) As Variant
    Dim zz動的配列() As Variant, zzセル_Loop As Range, zz配列要素数 As Long
    For Each zzセル_Loop In zzhセル範囲
        If zzセル_Loop <> "" Then
            ReDim Preserve zz動的配列(zz配列要素数)
            If zzhText取得 = False Then
                zz動的配列(zz配列要素数) = zzセル_Loop.Value
            Else
                zz動的配列(zz配列要素数) = zzセル_Loop.Text
            End If
            zz配列要素数 = zz配列要素数 + 1
        Else: End If
    Next zzセル_Loop
    zz配列要素数 = 0
    zzzセル範囲1次元配列化 = zz動的配列
End Function

引数に指定したセル範囲のデータを1次元配列に取得させる関数です

通常、セル範囲を配列に取得させると2次元配列になります
これは1列や1行しか指定しなかったとしても、必ず2次元配列になります
なぜならワークシートが2次元のデータだからです

セル範囲をそのまま配列に代入した場合の配列データ
関数を使用せず取得した場合

この画像は、配列にセル範囲をそのまま代入させた場合の配列データです
左のウィンドウにあるのが配列データです
+の記号を展開してもデータは1つしかありませんが、展開をしないとデータが見れません
これが2次元配列になっている状態である、ということです

この配列データでは、セル範囲データをリスト化などする際にデータの参照が少し煩雑になるし、この配列データに行データが1次元目なので、Preserveキーワードを使用して行方向にデータを追加することが出来ません

そんな色々と制約のある多次元配列では困ってしまう場合に使用するのがこの関数です

関数の書式

引数(太字は必須引数)
(zzhセル範囲, zzhText取得)
戻り値の型 Valiant型

「zzhセル範囲」は、配列データとするセル範囲の指定です
ここに指定したセル範囲が対象となります、セル範囲なので複数列や複数行もどちらも含むような範囲指定でも問題はありません

「zzhText取得」は、セルデータを値として取得するか、文字列として取得するかの指定になります
というのも、セルは表示形式という設定があり、値ではなく表示された見えている状態のデータを取得したい場合があります
その際に使用する設定です、ここにTrueを指定すると文字列として取得します
省略可能で、省略した場合はFalseが指定され値として取得を行います

コードの使用方法

Dim zz1次元 As Variant
zz1次元 = zzzセル範囲1次元配列化(Selection)

この関数が配列を返す関数なので、代入先はValiant型の変数を指定します
1行目の変数宣言の部分は、その変数を宣言しております

2行目で関数を使用して選択範囲を1次元配列化しています

関数を使用してセル範囲の値を1次元配列化したデータ
関数を使用して1次元配列化したデータ

画像の左側のウィンドウの配列データを上の画像と比べてみてもらうと分かりますが、+記号が無く、全てのデータが確認することが出来ることが分かると思います

なお、日付データの場合VBA上では画像の様に「#」で囲まれた状態になります
これが日付データであるという表現方法になります
また、3列目にDate型になっていることからも日付データとして取得できていることが確認できます

なお、この関数はデータをリスト化するなどの目的に使用することを前提としているため、空白のセルは無視します
画像では24行目まで選択されていますが、配列データが22番までとなっています
配列は0番から始まっているのでデータの総数は23個ということになります

選択範囲のセル数より少ない要素数になっているのはこのためです
これ以降にデータが存在しなければ、たとえA列全てを選択して100万セルを指定したとしても配列の要素数は23個というのが変わりません

Dim zz1次元 As Variant
zz1次元 = zzzセル範囲1次元配列化(Selection, True)

次に引数2つ目のzzhText取得にTrueを指定して処理を実行してみます

関数の2つ目の引数をTrueにしてセルの値を文字列として1次元配列化したデータ
引数「zzhText取得」をTrueで実行

画像の左側のウィンドウの配列データを確認してください
指定セル範囲は、上記のものと全く同じです
配列の個数も23個というのは同じです

ですが、取得しているデータには「#」が付いていません
代わりに「”」で囲まれています、これにより文字列で取得されていることが確認できます
同じように3列目を確認してみると、String型になっていることからも文字列として取得されていることが分かります

この文字列取得は、単純にデータを数値ではなく文字列で取得する
ということではなく、VBAのRangeオブジェクトのTextプロパティは表示された内容を文字列で取得する動きになります

例えば、金額の表示形式を設定すると「,」が3桁ごとに入力されます
「1500」は「1,500」という表示形式になります、表示形式なのでValueプロパティは「1500」を取得しますが、Textプロパティでは「1,500」という文字列を取得します

案外この表示形式後のデータで取得したい場合はあるので、その場合は引数2つ目をTrueに指定して関数を実行してください

コード解説

Function zzzセル範囲1次元配列化(ByVal zzhセル範囲 As Range, Optional zzhText取得 As Boolean = False) As Variant

~~ 中略 ~~

End Function

Functionプロシージャの処理範囲の始まりと終わりのコードです
Functionプロシージャは戻り値を持つプロシージャで、今回は配列データを返しますので、プロシージャの型はValiant型で宣言しています

この関数では、すでに解説したように2つの引数が指定できます
引数の内容に関してはすでに解説しましたので、割愛します
キーワードの解説のみ行います

1つ目の引数はByValキーワードが設定されています
これは引数の変数自体を値として受け取ることを意味しています
なので、このプロシージャ中でこの引数名の変数を変更しても呼び出し元に影響を与えない形になります、今回変更はしていないので省略しても構いません
また、セル範囲を指定してもらいたいので型はRange型になっています

2つ目の引数はOptionalキーワードが設定されています
これは引数が省略可能なことを意味しています
省略した場合は、Falseが指定されます
TrueとFalseの違いによる処理の分岐は後述します
2択の選択肢になるのでBoolean型になっています

    Dim zz動的配列() As Variant, zzセル_Loop As Range, zz配列要素数 As Long

使用する変数の宣言です
使用する変数は合計3つになります

「zz動的配列() As Variant」は、作成する配列データです
指定されたセル範囲にあるデータの個数で要素数が変化するので動的配列としています
またセル自体が何でも代入できるものなので、変数の型はValiant型で宣言します

「zzセル_Loop As Range」は、指定されたセル範囲をForループで使用するためのRange型の変数です

「zz配列要素数 As Long」は、動的配列の要素数を再定義する際に使用する整数です
この数字を1ずつ加算して要素数を増やしていきます

    For Each zzセル_Loop In zzhセル範囲

~~ 中略 ~~

    Next zzセル_Loop

引数に指定されたセル範囲を1セルずつループして検証を行います
全てのセルを参照するので、セルの個数が増えればそれだけ処理時間が伸びるので注意が必要ですが、そんなに大量なリストを作成する前提は考えていなので適宜対応を考えましょう

        If zzセル_Loop <> "" Then

~~ 中略 ~~

        Else: End If

この関数では空白はセル範囲に指定されていたとしても取得をしないようにしています
それがここのIf分岐になります
セルのデータが空白でなければデータを取得します

なお、関数などで空白が返されていた場合も取得は行いません
当然ですがデータリストに関数を取得させる必要が無いからです
関数は引数があって初めてデータとして成立するため、その関数構文を取得することに意味がありません

            ReDim Preserve zz動的配列(zz配列要素数)

動的配列の要素数の再定義です
取得するデータは空白を無視する仕様から、実際に全てセルの検証を終了してからしか要素数が分かりません

その為、動的配列でかつ都度再定義が必要になります
それをここで行っているわけです

「ReDim Preserve」は要素数の再定義を行い、その際取得済みのデータを保持するコードになります
要素数には整数値を指定しますが、Long型の変数を使用しています
Long型は初期値が0なので、そのまま変数を利用できます

            If zzhText取得 = False Then
                zz動的配列(zz配列要素数) = zzセル_Loop.Value
            Else
                zz動的配列(zz配列要素数) = zzセル_Loop.Text
            End If

ここが実際のデータの配列への取得箇所です
前提として、取得にはセルの値か表示形式の適用された見えているデータかを選択できるようにしていました
なので、ここでその選択によってIf分岐を使用して取得内容を変更しています

zzhText取得が省略されたり、Falseが指定されていれば値の取得を行います
なので、RangeオブジェクトのValueプロパティで取得します

逆にTrueが指定されていれば、RangeオブジェクトのTextプロパティを取得します
なお、このプロパティによって取得されるものは必ず文字列となります
数値であっても文字列になるのですが、その目的のための設定なので特にその動きで問題は無いはずです

また、この設定を混在させたいような複雑な処理は汎用化に向いていませんので、この処理を改造して作成してみてください

            zz配列要素数 = zz配列要素数 + 1

ここで要素数の再定義用のLong型変数を更新しています
配列データなので普通に1を加算しているだけです

    zz配列要素数 = 0
    zzzセル範囲1次元配列化 = zz動的配列

ループが終了したら、要素数再定義用変数は役割を終えているので初期値に戻しておきます
この後使うわけでもないので、無くてもいいです

そしてこの処理はFunctionプロシージャなので最後にプロシージャに作成した配列データを取得させます
これで、この関数の戻り値が確定したことになります

この後に使用した配列も初期化してもいいですね、しなくてもいいですけど
なお、Range型の変数はForループ終了時点で初期化されています
これはForループの仕様です

途中でも少し触れましたが、この関数はビッグデータを想定していません
せいぜい数千セル程度までを想定しています
1列全ての100万セルなら明らかに待ちます
さらに言うなら要素数の定義用変数がLong型なので21億程の範囲を超えるセル数ならエラー発生です

そんな意地悪なセル範囲は指定しないでね

ちなみに、セル範囲をこの関数を使用して1次元配列化したら
次に重複を除外する関数を使用することで、指定セル範囲の重複しないデータリストを作成することが出来ます
と、いうかその目的の為にこの記事の関数は作成しました
以下の記事でその続きの関数がありますので、利用ください

VBAの部品の使い方

このカテゴリにある記事を使う上での解説と注意点です

このカテゴリには、プロシージャとして作成されたコードが記載されています

これらは、いわゆるサブプロシージャと呼ばれるもので、本来の処理をサポート、または可読性向上に繋げる役割があります

ここにあるプロシージャは、広域関数なので同じプロジェクト内であればどこにあっても呼び出し可能です
ですが、どこに何があるか分からなくなると困るので1つ専用のモジュールを作成して、その中にコピペしてもらうようにした方がいいです

モジュールの作成は、VBAのメニューから簡単に行うことが出来ます
挿入メニューから標準のモジュールを追加してください
モジュールの名前は何でも構いません、参照することもありません

これで、部品を入れるモジュールが完成します
以下の記事で画像付きで解説していますので、参考にしてください

モジュールが作成出来たら、この中に記事トップにあるコードをそのまま貼り付けしてください

それで、あとは別のプロシージャで必要に応じて呼び出しを行えば利用可能です

また、記事にあるコードは一切解説コメントを付けていません
コードの意味を理解したい方は記事で解説を行っていますので、頑張ってスクロールして読んでください

おおよそはそんなんどうでもええわ、って場合が多いと思うのでそういった方々には邪魔な行になってしまうし、なによりそっちで解説しすぎるとこのサイトのこの記事はなんのために読んだらええのん?という素朴な疑問が払しょくできないからです

プロシージャについて

このカテゴリの記事には、大きく分けて2種類のプロシージャがあります

それが、SubプロシージャFunctionプロシージャです

これらの違いは戻り値を持つか持たないかと、Callステートメントを使うか使わないかの点になります

戻り値に関しては、正直引数を参照渡しにする方式であれば、処理中での計算値を返すことは出来るのでどうとでもなってしまいます

ですが、呼び出し方法に関しては対応していない方法ではエラーが出ますので注意が必要です

Subプロシージャの呼び出しについて

これには、Callステートメントを使用する必要があります
このステートメントは、他のプロシージャを実行する際に使用するものです

例えば、以下のようなSubプロシージャがあった場合で解説します

Sub zzzMsg(Optional zzString As String = "TestMsg")

MsgBox zzString

End Sub

このプロシージャは、引数を持っているSubプロシージャです
この引数は文字列型の引数になるので、処理の呼び出し時の引数に文字列を指定することで、この引数名に代入されます

処理内容としては、その引数に代入された文字列をメッセージボックスに表示するだけです

なお、引数名の前についている「Optional」キーワードは引数を省略することが出来ることを意味します
そして、省略された場合の初期値を型の後に指定することが出来ます
ここでは「”TestMsg”」が指定されていることを確認してください

引数があり、かつ省略可能なSubプロシージャとなりますのでCallステートメントの書き方は2通りあります

Call zzzMsg

この様に引数を省略して呼び出します、引数を全てを省略する場合や引数の存在しない場合はSubプロシージャの名前だけを記載するだけでいいです

引数を省略して実行した時のメッセージボックス
引数を省略したメッセージ

この場合に表示されるメッセージは画像の様に省略時の文字列になります

次に、引数を指定して実行する場合の解説です

入力時にクイックヒントが表示される

引数は「()」で囲んで入力します
「(」を入力した時点で、画像の様にクイックヒントが表示されます
ここでの表示は関数のものと同じです、「[]」で囲まれた引数は省略可能を意味しています
その際に、省略時の代入値も表示されているのが確認できます

Call zzzMsg("ProductionMsg")

そのまま引数に文字列を指定したのが、このコードになります
これを実行すると、引数に指定した文字列がメッセージボックスに表示されます

引数を指定して表示したメッセージボックス

画像の様に、引数に指定した文字列が表示されるようになります

Subプロシージャは、Callステートメントを使用して引数を利用する場合はその引数も含めてコードを記載することで処理を実行する事ができます

Functionプロシージャの呼び出しについて

こちらは関数と同じ使用方法になるので呼び出しはあまり難しくはありません
ですが、Functionプロシージャでの作り方がSubプロシージャと違う点があるので注意してください

Function zzzLoopString(zzLoopSt As String, Optional zzLoop As Long = 1) As String

zzzLoopString = String(zzLoop, zzLoopSt)

End Function

大きく違う点が2つあります
・引数の()の後に、プロシージャ自体の型宣言を行うこと
・プロシージャ名に代入することで戻り値となる

この2点に注目しながらFunctionプロシージャは読み取るようにしてください

このプロシージャでは、まず1行目後半部分で型宣言しています
String型になっていますので、この関数の戻り値は文字列であることが分かります

また、処理中でプロシージャ名に文字列を代入しています
つまりこの時点で戻り値が取得可能な状態である、ということです
このコード以降にも処理を作成することは可能です
その場合に、Exitステートメントなどでプロシージャを強制終了したとしても戻り値の取得は可能です

なおこのFunctionプロシージャは引数「zzLoopSt」に指定された文字列を引数「zzLoop」の回数繰り返して返す関数です
というか、そのためのString関数を実行しているだけです

MsgBox zzzLoopString("A", 4)

呼び出しを行う場合は、通常の関数同様、Functionプロシージャの名前を直接記載して実行します
引数に関しても関数同様で、「()」で囲んで指定を行います

ここでは、「A」を4回繰り返す文字列を取得してメッセージボックスに表示する処理になります

Functionプロシージャの返し値をメッセージボックスに表示
コードを実行した時に表示されるメッセージボックス

コードを実行すると、メッセージボックスが表示されます
その時に表示される内容は、Functionプロシージャで返された文字列です

ここで、少しわかりにくいかもしれませんが
この1行のステートメントで、Functionプロシージャの関数と、MsgBox関数の2つが実行されています
しかし、順番は先に引数のFunctionプロシージャが実行されてから、MsgBox関数が実行されていますので問題はありません

また、今回作成したFunctionプロシージャでは引数「zzLoopSt」は省略不可の設定になっています、Optionalキーワードを付けなければ省略不可となります

この設定で、引数を省略して記載した場合は実行時エラーが発生しますので注意してください

引数は都度合わせて行いますが、要はSubプロシージャはCallステートメントで呼び出す・Functionプロシージャはプロシージャ名だけで呼び出す、という形でOKです

重複しないファイル名を取得する関数

ファイルの名前を付けて保存する際に、重複しないファイル名を取得する関数です

Function zzz可能ファイル名(ByVal zz保存名 As String) As String

Dim zz保存名_前 As String, zz保存名_後 As String
Dim zz連番 As Long
Dim zz検証用文字列 As String
zz保存名_前 = Mid(zz保存名, 1, InStrRev(zz保存名, ".") - 1)
zz保存名_後 = Mid(zz保存名, InStrRev(zz保存名, "."))
zz連番 = 2

zz検証用文字列 = zz保存名
Do Until Dir(zz検証用文字列) = ""
    zz検証用文字列 = zz保存名_前 & "_(" & zz連番 & ")" & zz保存名_後
    zz連番 = zz連番 + 1
Loop
zzz可能ファイル名 = zz検証用文字列

End Function

ExcelVBAのコードで、ファイル名を付けて保存する処理があります
その際に、付けたいファイル名が使用済みであった場合上書き保存の確認が出てきたり、自動的に上書きされてしまったりします

エクスプローラー上での連番が振られて、ファイルが別ファイルとして保存されていくような処理はVBAで自動的に行うことは出来ません

実際に保存処理を行う前に、重複しない名前を取得しておく必要があります
その時に使用する関数です

この関数は、引数に指定したパス文字列のファイル名を重複する場合は連番を付けて返します
この関数で取得した文字列をファイル名の絶対パスとして指定すれば、重複することが無くなります

コードの使用方法

ThisWorkbook.SaveAs zzz可能ファイル名(ThisWorkbook.FullName)

このコードの様に、関数として引数を指定して使用します
ここでは、このコードのあるExcelブックを同じ場所に名前を付けて保存します

コードを数回実行した状態
コードを複数回実行

コードがある元々のExcelブックは「TestFile.xlsm」になります

そのファイルに上記の関数とコードを記載して、元ファイルを開きなおして数回実行したフォルダ内の状態です

元々のExcelブック名に連番を付けて保存します

コード解説

Function zzz可能ファイル名(ByVal zz保存名 As String) As String

・・・

End Function

使用可能な文字列を返すので、戻り値を利用するのでFunctionプロシージャで作成を行います
また、戻り値はパス文字列なのでString型で宣言しています

引数は1つ設定しています
zz保存名は、使用したいファイル名の絶対パス文字列を指定してもらいます
なお、ここでの処理ではその文字列があれば良いのでByValで引数を指定しています
これは引数を値渡しとするものです、処理中に変更したりはしませんので
参照渡しでもええっちゃええです

Dim zz保存名_前 As String, zz保存名_後 As String
zz保存名_前 = Mid(zz保存名, 1, InStrRev(zz保存名, ".") - 1)
zz保存名_後 = Mid(zz保存名, InStrRev(zz保存名, "."))

作成する保存名を作成するうえで必要なパス文字列として、引数として指定された文字列を一旦拡張子までで分割します
引数に指定する文字列は拡張子まで含めた絶対パス文字列になるので、文字列の最後にはファイルの拡張子が存在します

なので、この引数の文字列の後に単純に連番を追加しても有効なパス文字列にはなりません
その為に、分割した文字列を別々の変数にそれぞれ取得させます

その変数の宣言と、分割取得の箇所になります

Mid関数は、指定文字列の中から指定文字数を抜き出す関数です
これを文字数を指定することでパス文字列を分割取得することが出来ます

引数の中にある、InStrRev関数は指定文字列の中から特定の文字を検索して何文字目にあるかを返す関数です
InStrRev関数は、特定の文字を検索する場合に文字列の右側から検索を行います

今回分割したい文字列は拡張子の部分になります
なので「.」を検索する必要がありますが、この文字自体はファイル名やフォルダ名に使用することが可能です

その為、文字列の左側から検索した場合拡張子が取得できない可能性があります
また拡張子の文字数も3文字や4文字など固定されたものではありません
ですが、さすがにファイルの拡張子に「.」が使用されることはありませんので、文字列の右側から検索を行えば、確実に拡張子との分割箇所が特定できます

ちなみに、この関数は絶対パスから「\」を検索することでフォルダまでのパスに分割するような事にもよく使われます

Dim zz連番 As Long
zz連番 = 2

ファイルに結合する連番の整数値用の変数です
重複があれば数字を連結するので、この数値を使用するタイミングは前提として重複するものがあるという事なので、初期値は2から始めます

Dim zz検証用文字列 As String
zz検証用文字列 = zz保存名

検証用の文字列を一時的に代入するための文字列変数です

初期値として、引数の文字列をそのまま代入します
まず最初にこの代入した文字列で検証を行う形になります

Do Until Dir(zz検証用文字列) = ""
    zz検証用文字列 = zz保存名_前 & "_(" & zz連番 & ")" & zz保存名_後
    zz連番 = zz連番 + 1
Loop

ループ処理で、使用可能な連番の数値になるまで繰り返します

Dir関数でパス文字列が使用可能かどうかを検証しています
この関数は、引数のパスが有効であればそのファイル名のみを取得する関数です

パスのファイルが存在しない場合は、空白を返します
つまり、この関数で空白が取得されれば重複するファイル名が存在しないことが判定できます

ループ処理の中では、連番数字を連結した文字列を検証用文字列に代入しています
代入が終わってから、数値変数を加算しています

代入が終わったら、また上記の検証を行い
使用可能なパス文字列が生成されるまでループ処理を行います

zzz可能ファイル名 = zz検証用文字列

最後に、使用可能なパス文字列が代入された検証用文字列の文字列を関数名に代入します
これが、この関数の戻り値になります

関数の型は、String型なので文字列として、このパス文字列を返すことが出来ます