2022/03/06

会社番号検索システム

• １．背景
• ２．システム概要
• ３．プログラムの流れ
• ４．標準モジュール
• 　４－１．定数・変数の宣言
• 　４－２．システム起動
• 　　よりみち（オブジェクト変数の寿命）
• 　４－３．固定長ファイルからデータ読込
• 　４－４．ListObject（テーブル）のヘッダ部作成
• 　４－５．ListObject（テーブル）へのデータ貼付け
• 　４－６．固定長ファイルへのデータ書込み
• 　４－７．テーブルデータの並べ替え
• 　４－８．テーブルの絞り込み・解除
• 　４－９．絞り込みデータの配列化
• 　　よりみち（絞り込みテーブルのデータをDataObjectで配列化）
• 　４－１０．データをまとめてファイル化
• ５．ユーザーフォーム
• 　５－１．フォームのデザイン
• 　５－２．フォームモジュール
• 　　５－２－１．フォームの初期設定
• 　　５－２－２．テキストボックスの動作
• 　　　よりみち（複数の検索ワードの連動化）
• 　　５－２－３．リストの項目を選定
• 　　５－２－４．登録ボタン
• 　　５－２－５．削除ボタン
• 　　５－２－６．終了ボタン
• 　　５－２－７．絞り込みリストの作成
• ６．ワークシート
• ７．アドインとしてExcelにマクロを登録
• ８．最後に
• サンプルファイル

１．背景

取引先の会社名を管理するために、会社ごとのユニーク番号を対応させることは多いと思います。その番号として、国が管理している法人番号を使っているところもあれば、また法人番号は桁数が多い（12桁＋検査用数字1桁＝全13桁）ので、その会社独自の番号体系を作っているところもあると思います。
いずれにしても、その対応表さえあればExcelの検索機能を使ったり、VLOOKUP関数などで工夫したりすれば検索できるのですが、取引先が増えたり、社名が変わったりした時にデータが最新版になっていないと意味がありませんし、都度対応ファイルを探し出して開くのも大変です。

そこで今回は、会社番号の体系の知識（数字だけの番号だとか、先頭は記号だとかという体系。また、先頭番号・記号が表す意味は知っている　の様な感じ）は持っていたり、会社名の一部（なんとか設備、山田なんとか会社　の様な感じ）は知っていたりする場合に、検索をして「会社番号・会社名」を絞りこむシステムを紹介します。
Excelアドイン形式とすることで他のExcel作業途中でもすぐに検索が出来、データを共有サーバー等に置くことで常に最新（＝全員同じ）のデータが使える仕様としました。また、データの追加・修正・削除も可能です（どのPCからも修正・削除が出来てしまうのは、再考が必要かもしれません）。
それらを実現させるため今回システムでは、データには「固定長ファイル」を使い、そのデータを取り込んで検索をする段階では「ListObject（テーブル）」を使う方法としました。

なお本サイトで、他に固定長ファイルを使用したシステムとして紹介したのは下記になります。
「共有コメント付きカレンダー」
また、ListObject（テーブル）を使用したシステムとしては下記となりますので、参照頂ければ幸いです。
「DVD等の内容・保管場所等管理システム」
「先行予約可能な備品予約・貸出システム」
「ToDoリストで個人タスク管理」

２．システム概要

今回システムは、Excelにアドインして使用することを前提としています。アドインへの登録方法は「アドインとしてExcelにマクロを登録」を参照願います。
リボン上にアドイン登録されたマクロボタン（図２－１の①）をクリックすることで、システムが起動し操作ダイアログ②が表示されます。なお「サンプルファイル」では、ListObject（テーブル）があるSheet1上に起動ボタンを設けています。

図２－１

今回システムは「会社番号 ～ 会社名」の２項目の対応表を元に、検索などを行うものです。ダイアログの左側が会社番号、右側が会社名の枠になっています。
まず会社番号で検索を行う場合は、ダイアログ左上部のテキストボックス（図２－２の③）に「会社番号を先頭側から入力」していきます。今回システムでは会社番号での検索は「前方一致」で行っているためです。
例えば「1011801026090」という会社番号を検索する場合は、先頭側から「101･･･」と入力していきます。すると、絞り込みデータが少なく（設定では100件以下）なってきた所で、中央のリストボックスに「前方一致で絞り込まれたリスト」が表示されます。もちろん最後まで番号を入れてもOKで、その場合のリストは１つに絞られているはずです。
また会社名で検索を行う場合は、ダイアログ右上部のテキストボックス（図２－２の④）に「会社名の一部を入力」します。会社名は「部分一致」で検索していますので、例えば「有限会社酒井会計事務所」を探すのであれば、覚えている一部ワードである「会計」で検索すれば、何件かリストに表示されますので探しやすくなります。また、検索文字には「?（何か１文字 の意味）」も使用できます。
また、会社番号・会社名の両方のテキストボックスにワードを入れれば、両方に合致した検索を行います。
なお「100件以下にならないとリストに表示しない」仕様とした理由は、あまりにも多い件数をリスト表示しても探すのが大変ですし、またリストを作成するのにも処理時間が多く掛かると考えたためです。

表示されたリスト内の、目的の項目をクリック⑤すると、クリックした会社番号と会社名は上部のテキストボックスに入ります。テキストボックスですので、マウス等でコピペすればExcel以外にもデータを貼り付ける事が可能です。

図２－２

会社番号・会社名のデータは、「新規追加」「修正」「削除」が出来ます。
まず修正の場合は、修正するデータをリストからクリック⑤し、図２－３のように上部のテキストボックスに入ったデータに対して修正⑥を行います。「会社番号」「会社名」のどちらでも、また両方でもOKです。修正したら、下部の「登録ボタン⑦」をクリックします。
すると、確認ダイアログ⑧が出ますのでOKボタンをクリックするとデータ（サーバー上の共通データ）が修正⑨されます。

図２－３

なお、会社番号はユニーク番号（＝複数存在しない）としていますので、修正した会社番号が既に存在する番号の場合は、注意ダイアログを表示し、データを上書きするか否かの判断を促します。上書きした場合は、ユーザーが選択した項目は変更されずに残り、会社番号を修正した先の項目の会社名が変更されることになります。
また、会社名を変更した場合、同名の会社が存在する場合も注意ダイアログを表示します。なお「会社名が同じでも会社番号は異なる」のは可としています。

削除する場合は図２－４のように、削除するデータをリストからクリックし、下部の「削除ボタン⑩」をクリックします。すると、確認ダイアログ⑪が出ますのでOKボタンをクリックするとデータ（サーバー上の共通データ）が削除⑫されます。
一度削除されたデータは戻すことができませんので注意が必要です。

図２－４

新規にデータを作成する場合は図２－５のように、上部テキストボックスに「会社番号と会社名」を入力⑬し、「登録ボタン⑭」をクリックします。同じ会社番号・同じ会社名のデータが無ければ、が登録された旨のダイアログ⑮が表示され、データ（サーバー上の共通データ）が追加されます。なお、リストから他の項目を選択し、会社番号・会社名を書き換えて新たなデータとしてもOKです。

図２－５

なお、既に存在する会社番号だった場合は、その番号の会社名が変更されますし、同じ会社名だった場合にも注意ダイアログが表示されます。

システムを終了するには、右下の「終了ボタン」をクリックします。また、操作ダイアログ右上×印をクリックしても、システムが終了します。
なお今回の検索方法では、上部の「会社番号・会社名の両方の AND 検索」の結果が中央のリストボックスに表示されることになります。ですので、データの追加・修正・削除の作業が終了したのち、次の検索に入ろうとして、例えば「会社番号のみを変更」しても希望のデータは得られない事になります。それは会社名が「検索ワードとして残っている」からです。
私も何度も「何で検索されないんだろう？」と勘違いしましたので、次を検索する際は「テキストボックスを両方とも空にしてから開始」するのが良いかもしれません。

また、固定長ファイルからデータを読み取り、ワークシートにデータを貼り付けますので、データ件数は削除済み項目を含めて100万件以内であることが必要です。18000件程度のデータで試してみたら操作ダイアログが開くまでに4～5秒かかりますので、1万件程度が今回システムの限界かと思います。

３．プログラムの流れ

データは全て、固定長ファイルとして共有サーバー等に保存されます。各PCで今回システム（Excelアドインファイル）を起動すると、まず固定長ファイルを呼び出し、内容を全てアドインファイル内のワークシートに書き込みます。検索等をやり易くするために、データはテーブル化（ListObject化）します。その後で操作ダイアログを表示させます。

ユーザーが、操作ダイアログ上部のテキストボックスに検索ワード（会社番号、および会社名）を入力すると、テキストボックスのChangeイベントが発生し、テーブル上のフィルターをマクロ側から操作し、データの絞り込みを行います。そして絞り込んだデータを取得し、操作ダイアログのListBoxへ貼り付けます。なおテキストボックスに検索語を1文字追加しただけでも、その都度検索をしますので、ListBoxのデータ書き換え時間も考慮して「絞込み行数が100行以下になったらリスト化」するようにしています。

図３－１

操作ダイアログ上で、データの追加・修正を行う際には、操作ダイアログ下部の「登録」ボタンを使用します。ボタンをクリックすると、上部テキストボックスに「入力された会社番号」がテーブル内に存在しない場合は「追加」に、既に存在する場合は「修正」と判断し、データを固定長ファイルに書き込みます。

また、リスト上の項目を選択した上で「削除」ボタンをクリックした際は、選択している項目に対して、会社番号と会社名を空文字にしたデータを固定長ファイルに書き込みます。
行削除では無く、データのみをクリアしたイメージで、一度削除した固定長ファイルの行（レコード）は、ずっと削除状態のまま残ります。

４．標準モジュール（Module1）

４－１．定数・変数の宣言

標準モジュールの宣言部（先頭）では、システム内で使用する定数・変数の宣言を行っています。

1. '==========　⇩(1)　定数・変数の宣言　============
2. Const Fname As String = "Company.dat"
3. Const DataAddress As String = "¥¥Server¥Excel¥Data¥" & Fname
4. 'Dim DataAddress As String 　　 '←ﾃﾞｰﾀﾌｧｲﾙをｼｽﾃﾑExcelと同じ場所に置く場合
6. Const Tname As String = "CoTable"
8. Dim CoArray() As Variant
9. Dim systemSh As Worksheet
10. Public TBL As ListObject
12. Type Record
13. 　CoNo As String * 15
14. 　CoName As String * 100
15. End Type

図４－１

２～４行目は、データファイルの名前と場所の設定を行っています。
２行目「Const Fname As String = "Company.dat"」は、データファイルのファイル名を設定しています。名前は、拡張子も含めて何でもOKですが、固定長ファイルには「.dat」という拡張子が無難だと思います。
次にそのデータファイルの場所を設定するのですが、共有ファイルサーバー等に置く場合は、３行目「Const DataAddress As String = "¥¥Server¥Excel¥Data¥" & Fname」のように、サーバー内のディレクトリまでのPath＋２行目で設定したファイル名を、定数「DataAddress」として設定します。
また、システムファイルであるExcelファイルと同じ場所にデータを置く場合は、４行目「Dim DataAddress As String」のように「変数」としてDataAddressを宣言し、図４－２の１９行目「DataAddress = ThisWorkbook.Path & "¥" & Fname」で、Excelと同じ場所であることを設定します。
４行目・１９行目は、図の中では見え消しにしていますが、「サンプルファイル」では有効にしています。また３行目は逆にサンプルファイル内では無効にしています。実際に共有サーバーにデータを置く際には、３行目を有効にし、４行目・１９行目を無効にして下さい。
なお、３行目でファイル名として定数Fnameを使用するためには、それよりも前の位置（２行目）で定数Fnameの宣言をする必要があります。

６行目「Const Tname As String = "CoTable"」は、ListObject（テーブル）の名前を設定しています。「CoTable」はCompany Tableの略のつもりです。この名前も何でもOKです。

８行目「Dim CoArray() As Variant」は、固定長ファイル内の全データを格納する配列です。データの行数により配列の大きさが変わるため動的配列として宣言しています。なお、配列にデータを入れる今回の理由は、計算等の処理を早くする為では無く、ワークシートに一発で貼り付けたい為です。
９行目「Dim systemSh As Worksheet」は、データを貼り付ける場所（ワークシート）の変数宣言です。今回システムはアドインを前提にしているため、自分のシートだからと言って「Sheet1」や「Sheets("Sheet1")」と指定する訳にはいきません。ちゃんと自分（＝会社番号検索システム）のブック　ということを明示する必要があり「ThisWorkbook.Sheets("sheet1")」とする必要があります。しかし文字数が多いので、変数として設定をします。値は図４－２の２１行目で代入します。
１０行目「Public TBL As ListObject」は、データを貼り付けてListObject化した範囲を表す変数です。９行目と同じく、正式に記述すれば「ThisWorkbook.Sheets("sheet1").ListObjects("CoTable")」としなければならないので、簡略化するために変数として設定します。値は図４－２の２３行目で代入します。

１２～１５行目は、ユーザー定義変数の宣言をしています。
１２行目「Type Record」は、ユーザー定義型の変数名を「Record」と定義しています。
１３行目「CoNo As String * 15」は、変数Recordの中身の１つとして、CoNo（会社番号）を「文字列型15バイト」で変数定義しています。
１４行目「CoName As String * 100」も、変数Recordの中身の１つとして、CoName（会社名）を「文字列型100バイト」で変数定義しています。
イメージとしては「CoNoとCoNameのセットがRecord」であり、CoNoにアクセスするには「Record.CoNo」と指定する必要があります。

４－２．システム起動

システムを起動するプロシージャが図４－２です。Excelアドインに登録後、リボン上の起動ボタンのマクロには、この「CoSearch」を登録して下さい。なお、アドインへの登録方法は「アドインとしてExcelにマクロを登録」を参照下さい。

17. '==========　⇩(2)　システムの起動　============
18. Public Sub CoSearch()
19. '　DataAddress = ThisWorkbook.Path & "¥" & Fname 　　 '←ﾃﾞｰﾀﾌｧｲﾙをｼｽﾃﾑExcelと同じ場所に置く場合
21. 　Set systemSh = ThisWorkbook.Sheets("sheet1")
22. 　Call makeTBL
23. 　Set TBL = systemSh.ListObjects(Tname)
25. 　Call DataRead
26. 　Call DataPaste
28. 　UserForm1.Show 0
29. End Sub

図４－２

１９行目「DataAddress = ThisWorkbook.Path & "¥" & Fname」は、図４－１の４行目でDataAddressを「変数」として宣言する場合に、その変数にデータ場所＋ファイル名を代入します。図４－２では見え消しにしていますが「サンプルファイル」では有効にしています。

２１行目「Set systemSh = ThisWorkbook.Sheets("sheet1")」は、システムファイルであるExcelブック上のデータ貼付け場所（Sheet1）を変数systemShに指定しています。「ThisWorkbook」と限定するのは、今回システムがアドイン登録されるため、ユーザーが操作しているファイル側と明確に分離する必要があるからです。
２２行目「Call makeTBL」では図４－５を呼び出し、２１行目で指定されたワークシート上に「テーブル（ListObject）」を作成します。
２３行目「Set TBL = systemSh.ListObjects(Tname)」では、２２行目で作成したテーブルオブジェクト（テーブル名＝変数Tname）をTBLという変数に代入します。

２５行目「Call DataRead」では図４－３を呼び出し、固定長ファイルから全データを読み込み、配列に格納します。
２６行目「Call DataPaste」では図４－７を呼び出し、２５行目で作成したデータの配列を、２２行目で作成したテーブルのヘッダ部分の下に貼り付けます。これにより「全データが入ったテーブル」が完成します。

最後に２８行目「UserForm1.Show 0」で、操作ダイアログであるUserForm1をモードレス（ダイアログを表示させたまま、Excelシートの操作可）で起動します。

今回システムでは、２２行目の段階で「テーブルのヘッダ（タイトル）部分のみ」を作り、データ部分は２６行目で作成しています。これは、一旦テーブルそのものを削除してしまうと、その時点で２３行目のTBL変数も解除されてしまうためです。 当初、データの再読み込みの都度、テーブルごと削除したり作成したりしてみました。その方が、起動時のデータ読み込みと再読み込みの時とで、同じコード内容にできるからです。テーブルオブジェクトを直接指定（例：ThisWorkbook.Sheets("sheet1").ListObjects(Tname)）してさえすれば問題無いのですが、２３行目のような変数名（TBL）を使うと値が消えてしまいます。 テーブルオブジェクトを長々と記述するのもイヤなので、ヘッダ作成（＝テーブルオブジェクト作成）と、データ作成は別な工程とし、ヘッダが完成した後でオブジェクトを変数に代入することにしました。 まあ当然と言えば当然なのですが、参照している実体が無くならないように注意しなければ、と反省しました。

４－３．固定長ファイルからデータ読込

図４－２の２５行目、及び操作ダイアログのボタンをクリック（図５－９、図５－１２）した時に呼び出されるのが、図４－３です。共有フィアルサーバー等にあるデータファイル（固定長ファイル）からデータを読み込み、シートに貼り付けられる形にした配列CoArrayを作成します。

31. '==========　⇩(3)　固定長ファイルからデータ読込　============
32. Sub DataRead()
33. 　Dim fileNo As Integer 　　 '←ファイル番号
34. 　Dim dataRec As Record 　　 '←ユーザーレコード変数
35. 　Dim size As Long 　　　　 '←データの行数
36. 　Dim i As Integer 　　　　 '←データ位置のカウンタ変数
37. 　Dim buf As Variant 　　　 '←データの仮の入れ物
39. 　fileNo = FreeFile
41. 　On Error Resume Next
42. 　　Open DataAddress For Random As #fileNo Len = Len(dataRec)
44. 　　If Not Err.Number = 0 Then
45. 　　　MsgBox "データファイルが見つかりません。システム終了します。"
46. 　　　End
47. 　　End If
48. 　On Error GoTo 0
50. 　　size = Int(FileLen(DataAddress) / Len(dataRec))
52. 　　Select Case size
53. 　　　Case 0
54. 　　　　ReDim CoArray(1 To 1, 1 To 3)
56. 　　　Case Else
57. 　　　　ReDim CoArray(1 To size, 1 To 3)
59. 　　　　For i = 1 To UBound(CoArray, 1)
60. 　　　　　Get #fileNo, i, dataRec
62. 　　　　　CoArray(i, 1) = i 　　　 '←1列目
64. 　　　　　buf = Trim(Replace(dataRec.CoNo, Chr(0), ""))
65. 　　　　　If IsNumeric(buf) = True Then buf = "'" & buf
66. 　　　　　CoArray(i, 2) = buf 　　　 '←2列目
68. 　　　　　buf = Trim(Replace(dataRec.CoName, Chr(0), ""))
69. 　　　　　If IsNumeric(buf) = True Then buf = "'" & buf
70. 　　　　　CoArray(i, 3) = buf 　　　 '←3列目
72. 　　　　Next i
74. 　　End Select
76. 　Close #fileNo
77. End Sub

図４－３

３９行目「fileNo = FreeFile」は「ファイル番号」を取得しています。これは「fileNo = 1」などと決め打ちした時に、もし他のプログラムで既に「1」を使っている場合にはエラーが発生しますので、FreeFile関数を使って「空いているファイル番号」を取得します。

４１～４８行目では、データファイルを開いています。
４２行目「Open DataAddress For Random As #fileNo Len = Len(dataRec)」では、指定したファイル（DataAddress：図４－１の３行目、または図４－２の１９行目で指定）をランダムファイル（＝固定長ファイル）として開き、ファイル番号を「#fileNo」としています。
なお、Forの後ろに指定する「開き方」には、図４－４のように５種類が存在します。ランダムファイル（固定長）として操作するには「"Random"」を指定します。

ｷｰﾜｰﾄﾞ	モード	処理方法
Input	入力モード	読込
Output	出力モード	書込
Append	追加モード	書込
Random	ランダムアクセスモード	読込/書込
Binary	バイナリモード	読込/書込

図４－４

また、ランダムファイルの１データ分の長さを「Len =」として渡します。１データ分の長さは、図４－１の１２～１５行目で宣言したユーザー定義変数の全体の長さであるため「Len(dataRec)」と指定します。今回は「CoNo As String * 15」と「CoName As String * 100」が内容物となりますので合計115バイトとなります。

但し、ファイル名等が間違っていたり通信不良だったりして、データファイルが呼び出せない場合があります。その時のために４１行目「On Error Resume Next」でエラーをスルーさせ、ファイルを開くことが出来たか否かを４４行目「If Not Err.Number = 0 Then」のエラー番号で判断します。そしてエラーが出ている（＝ファイルが開けなかった）場合には、４５行目「MsgBox "データファイルが見つかりません。システム終了します。"」でコメントを出し、４６行目「End」で終了します。
ここで４６行目をEndでは無く「Exit Sub」としてしまうと、呼出し元の例えば図４－２内では、このDataReadの次の２６行目のDataPasteプロシージャを実行してしまいます。しかし配列CoArrayを作成していませんので、DataRead内でワークシートに貼り付ける際にエラーが出てしまいますし、なにしろデータを保存するファイル自体が見つからないのですから登録も出来ず、システム終了するしか手がありません。
ちなみに、もし他のExcelブックで稼働中のマクロがあった場合、４６行目でEndステートメントを使用しても、自分のマクロが停止するだけで、他には影響を与えないようです。

５０行目「size = Int(FileLen(DataAddress) / Len(dataRec))」では、データの行数を調べています。式の中の「FileLen(DataAddress)」のFileLen関数は、引数のファイル（DataAddress）のサイズをバイト数で戻すものです。また「Len(dataRec)」は、４２行目のOpenステートメントの最後のLen(dataRec)と同じで、１レコード（データ）当たりのバイト数です。
それを割り算していますのでデータの行数となり、結果を変数sizeに代入しています。なお、もしファイルに異常があった場合は、割り算の結果が小数点有りとなってしまいエラーが発生しますので、Int関数を使って整数処理をしています。

５２～７４行目では、データを配列CoArrayに格納しています。手順としては、配列CoArrayのサイズを設定した後、配列の各要素へデータを格納していきます。
データ行数は５０行目で計算済み（変数size）なので、配列の行サイズをその行数にするのですが、１つ問題があります。それはデータファイルのサイズがゼロの場合です。例えばデータファイルが存在しない状態で４２行目のOpenステートメントを実行すると、自動的に「ファイルサイズ＝ゼロ」のデータファイルを作成します。この場合、変数size ＝ 0 となりますので「配列CoArrayのサイズを設定する部分でエラー」が発生することになります。
ですので、まずは「変数sizeがゼロの時と、そうでは無い（＝データが１行以上ある）時とで処理を分ける必要があります。それが５２行目「Select Case size」です。

行数がゼロ（５３行目「Case 0」）の時は、５４行目「ReDim CoArray(1 To 1, 1 To 3)」で「１行×３列の空の配列」を作ります。本当は配列をEmpty状態にしたかったのですが、図４－１の８行目で「Dim CoArray() As Variant」と動的配列として宣言しなければならなかったのでEmpty状態に出来ず、空の配列を作ることとしました。
空の配列だと、図４－７のDataPasteプロシージャで配列CoArrayをシートに貼り付けた時「空の行」が出来てしまうことになります。しかし、今回システムでは「データ削除」により「データを空にする＝空行を容認」する仕様としていますので、問題はありません。空行は検索の対象に入れないようにしています（詳細はフォーム内の「UserForm_Activate」で説明します）。

行数が１行以上（５６行目「Case Else」）の時は、５７行目「ReDim CoArray(1 To size, 1 To 3)」で配列の行数をデータの行数にします。列数は３列で、１列目を「ファイルの行位置」２列目を「会社番号」３列目を「会社名」に割り当てます。
５９～７２行目では、ファイルの各行位置からデータを取得し、配列へ格納していきます。５９行目「For i = 1 To UBound(CoArray, 1)」は、カウンタ変数ｉを配列の行数（＝データの行数）分だけ回します。

６０行目「Get #fileNo, i, dataRec」では、データファイル（#fileNo）の行位置（ｉ）からデータを取得し、変数dataRecに代入します。変数dataRecは、図４－Ａの１２～１５行目で宣言したユーザー定義変数で、「dataRec.CoNo」で会社番号が得られ、「dataRec.CoName」で会社名が得られることになります。
６２行目「CoArray(i, 1) = i」では、配列の１列目にカウンタ変数ｉ（＝ファイルの行位置）を代入します。

６４行目「buf = Trim(Replace(dataRec.CoNo, Chr(0), ""))」は、取得した「会社番号」から文字以外の余計なものを削除しています。これは「共有コメント付きカレンダー」でも説明していますが、Excel側が「2バイト文字セット（半角でも全角でも1文字に2バイトを使用する）」を採用している関係から、Null文字やスペースが文字列の後ろにくっついているためです。
式の内容としては、会社番号（dataRec.CoNo）に対して、まずNull文字を「""（長さゼロの文字列）」に変換し、その後で前後のスペースを削除しています。

６５行目「If IsNumeric(buf) = True Then buf = "'" & buf」では、その会社番号が数値の場合は、先頭に「'（アポストロフィ―）」を追加して文字列にしています。これは、数値のままだと「前方一致検索」が出来ないためです。
６６行目「CoArray(i, 2) = buf」では、処理した会社番号のデータを配列CoArrayの２列目に代入しています。

６８～７０行目は３列目の処理ですが、上記で説明した２列目データの処理とほぼ同じです。異なるのは処理する対象が、会社名（dataRec.CoName）であることです。

配列CoArrayへのデータの代入が完了したら、７６行目「Close #fileNo」でファイルを閉じます。

４－４．ListObject（テーブル）のヘッダ部作成

図４－２の２２行目から呼び出されるのが、図４－５です。このプロシージャでは、ListObject（テーブル）のヘッダ部を作成しています。

79. '==========　⇩(4)　ListObjectのヘッダ部作成　============
80. Sub makeTBL()
81. 　Dim Title As Variant 　 '←テーブルのヘッダの文字列を入れる配列
83. 　Title = Array("Rno", "CoNo", "CoName")
85. 　On Error Resume Next
86. 　　systemSh.ListObjects(Tname).Delete
87. 　On Error GoTo 0
89. 　systemSh.Range("a1").Resize(1, 3).Value = Title
90. 　systemSh.ListObjects.Add(xlSrcRange, systemSh.Range("A1").CurrentRegion, , xlYes).Name = Tname
92. End Sub

図４－５

８３行目「Title = Array("Rno", "CoNo", "CoName")」は、テーブルの３列分のタイトル（ヘッダ）の配列を作成しています。そのまま貼り付けるだけでタイトルになるように、１次元配列で作成します。

８６行目「systemSh.ListObjects(Tname).Delete」では、既存のテーブルのデータ＋タイトルを含んだ「ListObject全てを削除」しています。今回システムでは、システム終了時（図５－１４のQueryCloseイベント）にテーブルを削除しているので、この８６行目のコードに意味はほとんどありませんが、ユーザーがテーブルを残すように細工をし且つテーブルを改ざんしていると、システムが正常に作動しないために、確実に削除し新たに作り直しています（アドイン内のワークシートなので、その可能性は低いと思いますが）。
そして、変数Tnameというテーブルが存在しなかった場合には「存在しないテーブルを削除しようとしている」としてエラーが発生します。ですので８５行目「On Error Resume Next」で、エラーをスルーさせています。

８９行目「systemSh.Range("a1").Resize(1, 3).Value = Title」では、Sheet1の「A1:C1」の範囲に８３行目で作成したタイトルの配列を貼り付けます。
９０行目「systemSh.ListObjects.Add(xlSrcRange, systemSh.Range("A1").CurrentRegion, , xlYes).Name = Tname」で、その１行目のタイトルを含んだ範囲を変数Tname（サンプルファイルでは『CoTable』）というテーブル名でListObjectを作成します。
９０行目を実行した直後の状態は図４－６で、タイトルのみのListObjectとなります。空行のように見える２行目の部分は「DataBodyRange」では無く、次にデータを入れる枠という意味の「InsertRowRange」になります。

図４－６

４－５．ListObject（テーブル）へのデータ貼付け

図４－２の２６行目、及び操作ダイアログのボタンをクリック（図５－９、図５－１２）した時に呼び出されるのが、図４－７です。

94. '==========　⇩(5)　テーブルへのデータ貼付け　============
95. Sub DataPaste()
97. 　Call TableFilterOff(TBL)
99. 　On Error Resume Next
100. 　　TBL.DataBodyRange.Delete
101. 　On Error GoTo 0
103. 　TBL.InsertRowRange.Resize(UBound(CoArray, 1), UBound(CoArray, 2)).Value = CoArray
105. 　Call TableSort(TBL, 2, 1)
106. End Sub

図４－７

このプロシージャの役割は、テーブルの既存のデータを全て消して、データファイルから読み込んだ新たなデータ（配列CoArrayの状態）をテーブルに貼付けることです。
まず、９７行目「Call TableFilterOff(TBL)」で図４－１６を呼出し、絞り込みのフィルターを解除（＝全データを表示状態）しています。このフィルター解除をせずに１００行目の「DataBodyRange.Delete」を実行しても、非表示の行は削除されません。

１００行目「TBL.DataBodyRange.Delete」は、テーブルのデータ部分を全て削除しています。しかしデータが一つも無い場合は「DataBodyRangeが存在しない」ので、９９行目「On Error Resume Next」でエラーが出てもスルーさせます。
なお、システム起動直後はデータ行が存在しないので１００行目は不要なのですが、データを追加・修正・削除した際にこのプロシージャが呼び出された時は、データ行が存在する可能性があるため、既存データ行を削除し新たなデータに置き換える手順を踏んでいます。

１０３行目「TBL.InsertRowRange.Resize(UBound(CoArray, 1), UBound(CoArray, 2)).Value = CoArray」は、図４－６で示したタイトル下の「InsertRowRange」の範囲に対して、Resizeプロパティで範囲を「貼り付けるデータ（＝配列CoArray）範囲」に広げた上で、配列CoArrayを貼り付けています。
データが１行も無い場合でもCoArrayは、データの入っていない「1行×3列」の配列にしていますので、InsertRowRange範囲そのままで空データを貼り付けます。貼り付けるとデータはありませんが、タイトル行の下はDataBodyRangeに変わります。

１０５行目「Call TableSort(TBL, 2, 1)」では図４－１０を呼び出し、テーブルを並べ替えています。引数には、第一引数として並べ替え対象であるTBL（データテーブル）を、第二引数は並べ替えの列位置なので2列目（＝会社番号）を、第三引数は並べ替え順序なので「1（昇順：小さい順）」を与えます。尚、降順にしたい場合は「2」にします。
この並び替えた順序は、リストボックスに表示される順序となります。

４－６．固定長ファイルへのデータ書込み

操作ダイアログの登録・削除ボタンから呼び出されるのが、図４－８です。引数として書込み位置（n）・会社番号（CoNo）・会社名（CoName）を受け取り、固定長のデータファイルにデータを書込みます。
データの追加・修正・削除の全てをこの１つのプロシージャで行っています。

108. '==========　⇩(6)　固定長ファイルへのデータ書込み　============
109. Sub DataUpdate(n As Long, CoNo As String, CoName As String)
110. 　Dim fileNo As Integer 　　 '← ファイル番号
111. 　Dim dataRec As Record 　　 '←ユーザーレコード変数
113. 　fileNo = FreeFile
115. 　On Error Resume Next
116. 　　Open DataAddress For Random As #fileNo Len = Len(dataRec)
118. 　　If Not Err.Number = 0 Then
119. 　　　MsgBox "データファイルが見つかりません。"
120. 　　　Exit Sub
121. 　　End If
122. 　On Error GoTo 0
124. 　　If n = 0 Then n = Int(FileLen(DataAddress) / Len(dataRec)) + 1
126. 　　dataRec.CoNo = CoNo
127. 　　dataRec.CoName = CoName
128. 　　Put #fileNo, n, dataRec
130. 　Close #fileNo
131. End Sub

図４－８

まず、操作ダイアログ側から送られてくる引数について、図４－９に整理をします。
修正と削除は、既存のデータを上書き（修正は新しい値で、削除は空文字で）します。しかし新規追加は「書き込む位置が操作ダイアログ上では不明」のため、プロシージャ内部で書込み位置を計算する、という意味のゼロが送られてきます。

操作	n	CoNo	CoName
新規追加	0(ゼロ)	新規の会社番号	新規の会社名
修正	修正ﾃﾞｰﾀの行位置	既存の会社番号	修正した会社名
削除	削除ﾃﾞｰﾀの行位置	""(長さ0文字列)	""(長さ0文字列)

図４－９

１１３行目「fileNo = FreeFile」では、空いているファイル番号を取得します。
１１６行目「Open DataAddress For Random As #fileNo Len = Len(dataRec)」では、指定したデータファイル（DataAddress）をランダムファイルとして開き、ファイル番号を「#fileNo」としています。そして、ランダムファイルとしての１レコードの長さを一番後ろに「Len = Len(dataRec)」として指定します。

なお、通信不良等でファイルが開けなかった時には、Openステートメントでエラーが発生しますので１１５行目「On Error Resume Next」でエラーをスルーさせ、エラー発生時は１１８行目「If Not Err.Number = 0 Then」で引っ掛け、１１９行目「MsgBox "データファイルが見つかりません。"」でコメントを出した後、１２０行目「Exit Sub」で処理中止します。

１２４行目「If n = 0 Then n = Int(FileLen(DataAddress) / Len(dataRec)) + 1」は、第一引数のファイル書込み位置（n）がゼロ（＝新規追加）だった場合に、「Int(FileLen(DataAddress) / Len(dataRec)) + 1」で、書込み位置を「現在の最終行位置（ファイルサイズ／１レコード当たりのバイト数）＋１」とすることで、データを追加することが出来ます。

１２６行目「dataRec.CoNo = CoNo」で会社番号として第二引数（CoNo）を、１２７行目「dataRec.CoNo = CoNo」で会社名として第三引数（CoName）を代入します。「データ削除」の時には、CoNoもCoNameも「""（長さゼロの文字列）」となります。
そして１２８行目「Put #fileNo, n, dataRec」で、データを指定した行位置（新規追加の場合は、最終行の下に追加する位置）に書き込みます。

最後に１３０行目「Close #fileNo」で、データファイルを閉じます。

４－７．テーブルデータの並べ替え

以降は、テーブルを直接操作するプロシージャ類です。
図４－１０は、テーブルのデータを並べ替えるプロシージャです。図４－７の１０５行目から呼び出されます。引数として、対象のListObjectオブジェクト（T）、並べ替える列名・列位置（col）、並べ替えの方向（Sorder：文字列（String）のOrderという意味のつもり）を受取ります。

133. '==========　⇩(7)　テーブルデータの並べ替え　============
134. Sub TableSort(T As ListObject, col As Variant, Sorder As Long)
135. 　With T.Sort
136. 　　.SortFields.Clear
137. 　　.SortFields.Add Key:=T.ListColumns(col).Range, Order:=Sorder
138. 　　.Apply
139. 　End With
140. End Sub

図４－１０

１３５行目「With T.Sort」で、Sortオブジェクトについて設定していきます。
１３６行目「.SortFields.Clear」では、Clearメソッドで並び替えレベルの初期化を行います。以前実行した並び替え条件がもし残っていると正しく並び替えができません。

１３７行目「.SortFields.Add key:=T.ListColumns(col).Range, Order:=Sorder」で、新たな並び替え条件を作成します。
Addメソッドのパラメータとして、まず「key:=T.ListColumns(col).Range」で、「並び替えの列のRangeオブジェクト」を第二引数で得た「列名col」を使って列を指定します。なお引数colは「列名」でも「列位置（整数）」でもOKです。今回システムでは、列数が少ないので「列位置」を使用しています。
最後のパラメータ「Order:=Sorder」では、並び替えの方向を指定します。第三引数で得た「並び順Sorder」を使用します。
パラメータOrderに設定する値は図４－１１のようになっており、今回システムでは「値」を使って指定していますが、定数を指定してもOKです。

Orderに設定する値

定数	値	内容
xlAscending	1	昇順で並べ替え（既定値）
xlDescending	2	降順で並べ替え

図４－１１

なお、Sort.Addのパラメータは図４－１２のように５つありますが、今回はKey（必須）とOrderのみを使用しました。他のパラメータは既定値でOKと判断したためです。

Sort.Addのパラメータ

名前	型	内容	既定値
Key	Range	並び替えの列(必須)	ー
SortOn	Variant	並び替えのキー	0＝値
Order	Variant	並び替え順序	1＝昇順で並べ替え
CustomOrder	Variant	ﾕｰｻﾞｰ指定の並び替え順序	ー
DataOption	Variant	データオプション	0＝数値とﾃｷｽﾄを別々に並替

図４－１２

また、Sortオブジェクトに設定できるプロパティは、SortFields以外にもいくつかあります（図４－１３）。こちらも既定値でOKと判断し省略しています。今回使用しなかったパラメータ・プロパティについては「DVD等の内容・保管場所等管理システム」でもう少し詳しく説明しています。

Sortの設定可能プロパティ

プロパティ	内容	既定値
Header	先頭行を見出しとするか	xlYes＝先頭行は見出し(固定)
MatchCase	大文字小文字の区別	False＝大文字と小文字を区別せず
Orientation	並べ替えの方向	xlSortColumns＝行方向の並替
SortFields	並び替えのキー値など	ー
SortMethod	ふりがなを使うか	xlPinYin＝ふりがなを使う

図４－１３

並び替えの設定が完了したら、１３８行目「.Apply」で「並び替えを実行」します。

４－８．テーブルの絞り込み・解除

テーブルの絞り込みを行うのが図４－１４です。
引数として、対象のListObjectオブジェクト（T）、絞り込む列名・列位置（col）、絞り込み条件（word）を受取ります。

142. '==========　⇩(8)　テーブルの絞り込み　============
143. Sub TableFilter(T As ListObject, col As Variant, word As String)
144. 　T.Range.AutoFilter Field:=T.ListColumns(col).Index, Criteria1:=word
145. End Sub

図４－１４

１４４行目「T.Range.AutoFilter Field:=T.ListColumns(col).Index, Criteria1:=word」では、見出しを含めたテーブル全体「T.Range」に対してフィルターを実行しています。
１つ目のパラメータ「Field:=T.ListColumns(col).Index」では、テーブルの左側から数える「列番号」を整数で指定します。第二引数として得ているcolは「列名」または「列番号」のどちらかですので、整数の列番号に揃えるために「T.ListColumns(col).Index」を使用します。なお、引数を「列番号のみ」とするのであれば直接「 Field:=col」と出来ますが、呼出し側のコードが読み難くなってしまう場合があるのと、列の順番を入れ替えたり、列を追加したり出来なくなるデメリットも生じます。

２つ目のパラメータ「Criteria1:=word」は、第三引数の「絞り込み条件」をCriteria1に設定しています。今回システムではワードで絞り込みを行っているのでCriteria1パラメータのみでOKですが、数値を範囲で絞り込むような場合は図４－１５のように他のパラメータも使って絞り込みます。

AutoFilterメソッドのパラメータ

名前	型	内容
Field	Variant	ﾌｨｰﾙﾄﾞ番号
Criteria1	Variant	抽出条件
Operator	XlAutoFilterOperator	2つの条件を関連付ける演算子 xlAnd、xlOrなど
Criteria2	Variant	2番目の抽出条件
SubField	Variant	抽出条件を適用するﾃﾞｰﾀ型のﾌｨｰﾙﾄﾞ
VisibleDropDown	Variant	ｵｰﾄﾌｨﾙﾀのﾄﾞﾛｯﾌﾟﾀﾞｳﾝ矢印の表示非表示

図４－１５

絞り込んだ後は、絞り込みを解除する必要がありますが、そのプロシージャが図４－１６です。引数として対象のListObjectオブジェクト（T）を受取ります。

147. '==========　⇩(9)　テーブルの絞り込み解除　============
148. Sub TableFilterOff(T As ListObject)
149. 　T.ShowAutoFilter = False
150. 　T.ShowAutoFilter = True
151. End Sub

図４－１６

絞り込みを解除するには、「T.AutoFilter Field:=i」というCriteria1パラメータが無いコードを列数分（ｉ）だけ繰り返す方法が一般的なようですが、今回は「フィルターを一旦非表示にし、その後で再表示」させる方法としました。この方法によるメリットは 「先行予約可能な備品予約・貸出システム」でも説明していますが、処理速度が約1/4に早くなる事です。

１４９行目「T.ShowAutoFilter = False」で、フィルターを一旦非表示にし、１５０行目「T.ShowAutoFilter = True」で再表示しています。この非表示・再表示の操作だけで、絞り込みを全解除できます。

４－９．絞り込みデータの配列化

絞り込まれたテーブルのデータを配列の形にするのが図４－１７です。引数として対象ListObjectオブジェクト（T）を受取ります。

153. '==========　⇩(10)　絞り込みデータの配列化　============
154. Function SearchList(T As ListObject) As Variant
155. 　Dim buf1 As Variant 　　 '←改行マークで区切った配列
156. 　Dim buf2 As Variant 　　 '←TABマークで区切った配列
157. 　Dim buf3() As Variant 　 '←最終形状の二次元配列
158. 　Dim i As Long 　　　　　 '←配列の行位置
160. 　On Error Resume Next
161. 　　T.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
162. 　　If Not Err.Number = 0 Then Exit Function
163. 　On Error GoTo 0
165. 　With New MSForms.DataObject
166. 　　.GetFromClipboard
167. 　　buf1 = Split(.GetText, vbCrLf)
168. 　End With
170. 　ReDim buf3(0 To UBound(buf1, 1) - 1, 0 To 2)
172. 　For i = 0 To UBound(buf3, 1)
173. 　　If Not buf1(i) = "" Then
174. 　　　buf2 = Split(buf1(i), vbTab)
175. 　　　buf3(i, 0) = buf2(0)
176. 　　　buf3(i, 1) = buf2(1)
177. 　　　buf3(i, 2) = buf2(2)
178. 　　End If
179. 　Next i
181. 　Application.CutCopyMode = False
183. 　SearchList = buf3
184. End Function

図４－１７

従来「ToDoリストで個人タスク管理　など」のListObjectを使ったシステムでは、絞り込んでいるか否かを、行の高さや行のプロパティを使って調べ、可視状態の行の値だけを配列に格納する方法を取ってきました。 しかし「For～Nextでグルグル回しながらチェックして、それが対象行であれば値を取り出す」といのは、あまり芸が有るとは言えないと感じていました。絞り込んだセル範囲をコピーし、他のシートに貼り付ければ「絞り込んだデータだけが貼り付く」事は知っていたので、これをなんとか使えないかと更に調べて思いついたのが今回の方法です。 MSFormsライブラリのメンバの１つにDataObjectオブジェクトがあり、これを使うとクリップボードにデータを送信したり、クリップボードからデータを受信する事ができます。今回の操作に関係ありそうなプロパティ・メソッドを図４－１８に整理します。 ｵﾌﾞｼﾞｪｸﾄ ﾌﾟﾛﾊﾟﾃｨ／ﾒｿｯﾄﾞ 内容 DataObject SetText ﾃｷｽﾄ文字列をDataObjectにｺﾋﾟｰする PutInClipboard ﾃﾞｰﾀをｸﾘｯﾌﾟﾎﾞｰﾄﾞに格納する GetFromClipboard ｸﾘｯﾌﾟﾎﾞｰﾄﾞからDataObjectにﾃﾞｰﾀをｺﾋﾟｰする GetText DataObjectからUnicode形式でﾃｷｽﾄﾃﾞｰﾀ取得する Application ClipboardFormats ｸﾘｯﾌﾟﾎﾞｰﾄﾞに格納されているﾃﾞｰﾀ形式を返す｡ 無ﾃﾞｰﾀの場合は､ClipboardFormats(1)に｢-1｣ が入る 図４－１８ 今回考えた手順は、図４－１９の通りです。 図４－１９ テーブル上で絞り込んだデータ範囲をコピーし、データをクリップボードに入れます。そのクリップボードのデータをGetFromClipboardメソッドでDataObjectにコピーし、GetTextメソッドでテキストデータとして取得します。 調べたところ、このデータはExcelのセル単位のようなものでは無く、メモ帳のデータのようなもののようです。行方向は「改行マーク」で、列方向は「TABマーク」で文字列が区切られているようです。ですのでVBAのsplit関数を２回繰り返して要素単位にし、配列に格納します。 なお「コピー」を使わずにSetTextメソッドで直接DataObjectにデータを持っていけないか（理由：クリップボードは、ユーザーや他のアプリが使用する可能性があるため、ちょっと危険そう）と考えたのですが、「可視セルをテキスト状態にするのでは、今までのやり方と何ら変わらない」のでは無いか、また「その面倒な操作をO/Sがやってくれるのだから有難い」と思い直し、コピーでクリップボード経由にする事にしました。 ちなみに「New MSForms.DataObject」という宣言方法ではなく、CreateObjectを使って実行時バインディングを行おうとすると、図４－２０のようにしなければならず、逆に分かり難くなるので今回は使用しませんでした。 　Dim CB As Object 　Set CB = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 　With CB 　　.GetFromClipboard 　　buf1 = Split(.GetText, vbCrLf) 　End With 図４－２０

１６１行目「T.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy」は、絞り込んだデータ範囲をコピーします。
しかし、絞り込み行が１行も無い場合にはエラーが出ますので１６０行目「On Error Resume Next」でエラーをスルーさせ、１６２行目「If Not Err.Number = 0 Then Exit Function」でエラーが出ている場合には、この関数プロシージャを抜け出します。
抜け出した場合、戻り値を設定していない為にVariant型の既定値Emptyが関数の戻り値になります。

１６５行目「With New MSForms.DataObject」で、DataObjectオブジェクトを生成します。
１６６行目「.GetFromClipboard」で、クリップボードに貼り付けた「絞り込みデータ」をDataObjectオブジェクトにコピーします。
１６７行目「buf1 = Split(.GetText, vbCrLf)」の中の「.GetText」の部分で、テキストデータが得られます。このテキストデータは、行方向は「改行マーク（vbCrLf）」で、列方向は「TABマーク（vbTab）」で文字列が区切られています。
まずはレコード単位の配列にすべく「改行マーク（vbCrLf）」で区切って、配列buf1に代入します。
なお「vbLf」で区切っても、レコード単位の配列には一見なりますが、会社名の一番後ろに「vbCr」が残ってしまいます。
また、テキストデータの最後尾に「vbCrLf」が必ずくっついているようで、出来上がった配列の最終要素は必ず空の要素になります。

１７０行目「ReDim buf3(0 To UBound(buf1, 1) - 1, 0 To 2)」では、最終形状の二次元配列のサイズを決めます。
インデックスは今回ゼロ始まりとしました。理由は、この配列を使って作業する内容が「操作ダイアログ上のリストボックスへのデータ貼付け」で、リストボックスのインデックスもゼロ始まりなので、ゼロ同士合わせました。
配列の行側のサイズは、「配列buf1の最終要素は必ず空の要素」ですので、「-1」をしています。列側は３列固定なので、0～2のインデックスとしました。

１７２～１７９行目では、各レコードを列方向にTABマークで区切りながら、最終形状の配列に値を代入していきます。
１７２行目「For i = 0 To UBound(buf3, 1)」は、最終形状配列の行数分だけ、カウンタ変数ｉを回します。

１７３行目「If Not buf1(i) = "" Then」は、データが空で無い時だけ１７４～１７７行目の処理をします。理由は、長さゼロの文字列だとSplit関数で分割できず、buf2が配列にならない為に「buf2(0)」の部分でエラーが発生するからです。
しかし今回は３列分をCopyしているため、１行分のデータbuf1内には必ずTABマークが２つ入っているので「buf1(i) = ""」とはなりません。また削除行であっても、ファイル行位置の数値（１列目のデータ）は入っているので、最低でも数値のデータとなります。そのため基本的に１７３行目は全データがすり抜けます。
それでもこの「空行排除」のコードを置いたままにしているのは、今後違うシステムを作りこのコードをコピペで流用した時、その時のテーブルが１列のみだった場合には空行でエラーが発生してしまうと考えたからです。

しかしそうなると、空行を拾ってしまった場合にリストボックスに空行が出来てしまい、ユーザーが空行を選択できてしまう事になります。これでは仕様上都合が悪いので、起動直後から会社番号と会社名の列を「*（アスタリスク）」で絞り込みをし、空行を排除しています。

１７４行目「buf2 = Split(buf1(i), vbTab)」では、１レコードのデータを今度はTABマークで分割し、配列buf2に代入します。
１７５行目「buf3(i, 0) = buf2(0)」ではレコード内を分割した中の１番目（インデックス＝０）のファイル行位置データを最終形状の配列（buf3）の１列目（インデックス＝０）に代入します。同様に１７６行目「buf3(i, 1) = buf2(1)」では会社番号を２列目に、１７７行目「buf3(i, 2) = buf2(2)」では会社名を３列目に代入します。

１８１行目「Application.CutCopyMode = False」は、コピーモードを解除しています。なお、解除タイミングはこの位置でなくても、１６６行目の「.GetFromClipboard」で「クリップボードのデータをDataObjectオブジェクトへコピーした後」であれば、いつでもOKです。もし時間の掛かる処理があるのであれば、早々に解除した方が良いかもしれません。

最後に１８３行目「SearchList = buf3」で、最終形状配列buf3をこの関数プロシージャの戻り値に設定します。

４－１０．データをまとめてファイル化

図４－２１はプログラム中では使用しません。「手動でリストをファイル化」するためのプロシージャです。

186. '==========　⇩(11)　データをまとめてファイル化　============
187. Sub DataWrite()
188. 　Dim fileNo As Integer 　 '←ファイル番号
189. 　Dim dataRec As Record 　 '←ユーザーレコード変数
190. 　Dim i As Integer 　　　 '←データ位置のカウンタ変数
192. 　fileNo = FreeFile
194. 　Open DataAddress For Random As #fileNo Len = Len(dataRec)
196. 　With ThisWorkbook.Sheets("sheet1")
197. 　　For i = 1 To .Cells(1, 2).CurrentRegion.Rows.Count
198. 　　　If .Cells(i + 1, 2) = "" Then Exit For
200. 　　　dataRec.CoNo = .Cells(i + 1, 2)
201. 　　　dataRec.CoName = .Cells(i + 1, 3)
202. 　　　Put #fileNo, i, dataRec
203. 　　Next i
204. 　End With
206. 　Close #fileNo
207. End Sub

図４－２１

使い方としては、社内に既にあるデータを図４－２２のような形で、連続的にシートに貼り付けた後、このDataWriteプロシージャを手動実行させます。なお、固定長ファイルのファイル名「DataAddress」が定数でなく変数設定の場合は、プロシージャ実行前に変数を有効にしておく必要があります。
また、データを同じファイルに重ね書きする事は可能ですが、重ね書きの方が行数が少ない場合は、昔のデータが残ってしまうことになるので注意が必要です。

図４－２２

１９２行目「fileNo = FreeFile」は、空いているファイル番号を取得します。
１９４行目「Open DataAddress For Random As #fileNo Len = Len(dataRec)」は、データファイルをランダムファイルとして開いています。
１９６行目「With ThisWorkbook.Sheets("sheet1")」は、このブックのSheet1にデータがある前提にしています。

１９７～２０３行目でワークシートのデータを固定長ファイルに格納しています。
１９７行目「For i = 1 To .Cells(1, 2).CurrentRegion.Rows.Count」で、最後のデータまでカウンタ変数ｉを回します。CurrentRegionを使用しているので、途中で空行があると最後まで書き込まれない可能性があります。
１９８行目「If .Cells(i + 1, 2) = "" Then Exit For」では、会社番号が空白セルだと処理を終わらせます。

２００行目「dataRec.CoNo = .Cells(i + 1, 2)」は、２列目セル値の会社番号を変数CoNoに代入し、２０１行目「dataRec.CoName = .Cells(i + 1, 3)」は、３列目セル値の会社名を変数CoNameに代入します。
そして、２０２行目「Put #fileNo, i, dataRec」で、１レコード分を固定長ファイルに入れます。

データを入れ終えたら２０６行目「Close #fileNo」で、ファイルを閉じます。
あまりチェックをしていないので、データの状態によってはエラーが出るかもしれません。御了承下さい。また、先頭がゼロで始まる会社番号は、列を文字列書式にする等の工夫が必要かと思います。ご参考まで。

５．ユーザーフォーム（UserForm1）

５－１．フォームのデザイン

フォームには、上部に検索ワードの入力などに使用するTextBoxを２つ置き、中央にその結果を表すListBoxを配置します。
下部には「登録（修正）」「削除」「終了」ボタンを置き、絞り込み件数を表示するLabelを置きます。
配置するコントロール類の初期設定はマクロ側から行いますが、説明用のLabelは配置時に手動でCaption設定を行っています。

図５－１

５－２．フォームモジュール

５－２－１．フォームの初期設定

フォームモジュール先頭（宣言部）では、図５－２のようにフラグ変数EventOffの宣言をしています。

209. '==========　⇩(12)　変数の宣言　============
210. Dim EventOff As Boolean

図５－２

リストボックスから目的のデータをクリックすると、選択項目を上部のテキストボックスにコピーをします。しかしテキストボックスには検索実行のためのChangeイベントを仕掛けているため、コピーをした途端に検索が実行されてしまい、リストボックスの項目が消えてしまう事になります。
そこで、リスト項目を残したままテキストボックスに値をコピーするために「Changeイベントを発生させない」フラグ変数を準備することにしました。その宣言が２１０行目「Dim EventOff As Boolean」です。

フォーム起動後、最初に呼び出されるイベントが図５－３のInitializeイベントプロシージャです。

212. '==========　⇩(13)　フォームの設定１　============
213. Private Sub UserForm_Initialize()
214. 　Me.CommandButton1.Caption = "登録"
215. 　Me.CommandButton2.Caption = "削除"
216. 　Me.CommandButton3.Caption = "終了"
218. 　Me.Label1.TextAlign = fmTextAlignRight
220. 　Me.ListBox1.ColumnCount = 3
221. 　Me.ListBox1.ColumnWidths = "0;80;150"
222. End Sub

図５－３

２１４～２１６行目は、３つのボタンの表面文字の設定です。
２１４行目「Me.CommandButton1.Caption = "登録"」では、登録ボタンを、２１５行目「Me.CommandButton2.Caption = "削除"」では削除ボタンを、２１６行目「Me.CommandButton3.Caption = "終了"」では終了ボタンを設定します。

２１８行目「Me.Label1.TextAlign = fmTextAlignRight」は、絞り込み件数を表すラベルの文字位置を数値らしく右寄せにしています。

２２０行目「Me.ListBox1.ColumnCount = 3」は、データを表示するリストボックスを３列表示にしています。３列とは「ファイル行位置」「会社番号」「会社名」です。
２２１行目「Me.ListBox1.ColumnWidths = "0;80;150"」は、その３列のリストボックス上での列幅を設定しています。リストボックスの全体幅は約240ポイントです。
ユーザーには「ファイル行位置は不要」ですので、１列目の幅はゼロとしています。表示する「会社番号」「会社名」は適当な幅にしてありますが、その合計値は全幅－３を超えないようにしています。ListBoxで複数列を使用する場合の設定については「先入先出の入出庫管理システム」を参照下さい。

フォームが表示された直後に呼び出されるのが、図５－４のActivateイベントプロシージャです。

224. '==========　⇩(14)　フォームの設定２　============
225. Private Sub UserForm_Activate()
226. 　Call TextBox1_Change
227. End Sub

図５－４

２２６行目「Call TextBox1_Change」では、図５－６を呼出しています。呼出し先では「テキストボックスのValue値に従ってテーブルを検索開始」しますが、まだこの時点ではテキストボックスには値が入っていません。
検索は前方一致・部分一致で行いますので、検索式の中に「*（アスタリスク）」が入っています。つまり「*」のみで文字列を検索することになり、テーブル上の「空データの行は検索されずに非表示」になります。
これにより、検索結果を表示するリストボックスには空行が入らず、「空行を選択できてしまう」ような不具合がなくなります。

５－２－２．テキストボックスの動作

会社番号欄（TextBox1）に入る時に発生するのが、図５－５のEnterイベントプロシージャです。

229. '==========　⇩(15)　会社番号欄のIMEモードOFF　============
230. Private Sub TextBox1_Enter()
231. 　Me.TextBox1.IMEMode = fmIMEModeOff
232. End Sub/li>

図５－５

２３１行目「Me.TextBox1.IMEMode = fmIMEModeOff」で、IMEモードをOFFにします。会社番号は半角が主だと思いますので、まずは半角にした方がユーザーが使い易いのでは、と思い設定しました。なお「fmIMEModeDisable」では無いので、漢字ボタンを押せば全角文字の入力は可能です。

会社番号欄（TextBox1）の値を変更した時に発生するのが、図５－６のChangeイベントプロシージャです。

234. '==========　⇩(16)　会社番号欄のChangeイベント　============
235. Private Sub TextBox1_Change()
236. 　If EventOff = True Then Exit Sub
238. 　Call TableFilter(TBL, 2, "=" & TextBox1.Value & "*")
239. 　Call TableFilter(TBL, 3, "=*" & TextBox2.Value & "*")
241. 　Call makeList(TBL)
242. End Sub

図５－６

このテキストボックスのChangeイベントの機能は、テキストボックスに入力されたワードで会社番号・会社名のリストを絞り込み、絞り込まれた項目をリストボックスに表示するものです。

２３６行目「If EventOff = True Then Exit Sub」については、他のコードの後で説明します。

２３８行目「Call TableFilter(TBL, 2, "=" & TextBox1.Value & "*")」は、図４－１４を呼び出してテーブルの絞り込みを行います。第一引数はテーブルオブジェクト、第二引数は列位置で「2」は「会社番号」を指します。第三引数は絞り込み条件で、会社場号（TextBox1.Value）の後ろ側に「*（アスタリスク：0個以上の文字列）」を付けていますので「前方一致」となります。
２３９行目「Call TableFilter(TBL, 3, "=*" & TextBox2.Value & "*")」では、第二引数は「3」で「会社名」となります。絞り込み条件は、会社名（TextBox2.Value）の前後両方に「*」を付けていますので、部分一致（文字列中に同じ文字列があればヒットする）となります。

２４１行目「Call makeList(TBL)」は、図５－１５を呼び出し、２３８～２３９行目で絞り込んだ項目のみを取得し、リストボックスに表示させます。

ここで、TextBox1のChangeイベントなのに「TextBox1とTextBox2の両方について検索」をしている点について説明します。 今回リストボックスの項目を選択すると、リストボックスに表示された項目はそのままにして、上部テキストボックスにリスト選択項目を書き込む仕様としました。 通常テキストボックスに何か入力するとChangeイベントが働いて検索→リスト更新をするのですが、上記仕様を成立させる為に、リストボックスを選択した時だけはそのChangeイベントが発生しないようにする（≒イベントをスルーさせる）ようにしました。 その時点で既に、テキストボックスの「検索ワード」とリストボックスに表示されている項目は「整合性が取れていない」状態なのですが、リストボックスを選択している状態（選択項目が青い）がユーザーに見えるので、まだ許されるかな　と思っています。 しかし、そのテキストボックスにコピーされたリスト選択項目をユーザーが編集した時は、「テキストボックスを編集→絞り込み→リスト更新」という正規のテキストボックスの動作をすることになります。が、「各テキストボックスのChangeイベント内がそれぞれのテキストボックスのみのワードで絞り込みをする」仕様だと、例えば会社番号だけを編集した場合、会社番号のChangeイベントは発生しますが、会社名のChangeイベントは発生しません（変更していないのですから）。 すると、２つのテキストボックスの内容とリストの内容が「整合性が取れていない」状態になります。リスト上を選択している訳でもないのに整合性が取れていない状態ではユーザーが混乱します。なにしろ、作っている本人が「なに、これ？？」と思うくらいですから、たぶん一般にも受け入れられないのではないかと思います。 ということで、絞り込み工程は増えてしまいますが整合性を重視し、一方を変更したら「会社番号・会社名の両方で絞り込み」を行うことにしました。

２３６行目「If EventOff = True Then Exit Sub」は、フラグ変数EventOffがTrueの状態の時は、Changeイベント内の「絞り込みとリスト更新」をスルーさせるものです。
通常フラグ変数EventOffは既定のFalseなので、ユーザーがテキストボックスを編集した時には２３６行目は成立せずに、絞り込みとリスト表示を行います。しかし今回システムでは「表示されたリストの項目を選択した時には、リストをそのままの状態に保ったままテキストボックスに選択項目を表示」する仕様としました。
その「リストをそのままの状態に保つ」ために、リスト選択時にはフラグ変数EventOffをTrueにし、テキストボックスに値が入っても絞り込みを行わない様にしています。

会社名欄（TextBox2）の値を変更した時に発生するのが、図５－７のChangeイベントプロシージャです。

244. '==========　⇩(17)　会社名欄のChangeイベント　============
245. Private Sub TextBox2_Change()
246. 　Call TextBox1_Change
247. End Sub

図５－７

TextBox1またはTextBox2のどちらを変更しても、常に両方のテキストボックスの値で絞り込みを行うようにしています。そのため、絞り込み＋リスト更新の工程はTextBox1（図５－６）の方にまとめ、このTextBox2のChangeイベントが発生した際には２４６行目「Call TextBox1_Change」で、テキストボックス１（会社番号）のChangeイベントを呼び出すだけにしています。

５－２－３．リストの項目を選定

絞り込みリストの項目のどれかを選択した時に呼び出されるのが図５－８です。

249. '==========　⇩(18)　リストの項目を選定　============
250. Private Sub ListBox1_Click()
252. 　EventOff = True
253. 　　Me.TextBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
254. 　　Me.TextBox2.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 2)
255. 　EventOff = False
257. End Sub

図５－８

２５３行目「Me.TextBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)」で、リストボックスの選択行の２列目（インデックス＝１）の会社番号を、操作ダイアログ上部の会社番号枠（TextBox1）に貼り付けます。
２５４行目「Me.TextBox2.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 2)」で、リストボックスの選択行の３列目（インデックス＝２）の会社名を、操作ダイアログ上部の会社名枠（TextBox2）に貼り付けます。

TextBox1、TextBox2に文字列を入れた時にはテキストボックスのChangeイベントが発生してしまい、リストボックスの絞り込みリストが更新（２５３～２５４行目で貼り付けた値のみの１項目がリスト化されることになる）されてしまいます。
（正確に言うと、２５３行目が実行された時点で、リストボックスはその会社番号のデータ１行のみに絞られると同時に、リストボックスを選択していない状態になってしまいますので、ListIndex = -1 となりエラーが発生します。）
そのため、２５２行目「EventOff = True」でフラグ変数EventOffをTrueにし、図５－６の２３６行目「If EventOff = True Then Exit Sub」ですぐにChangeイベントプロシージャを抜け出させ、リスト更新させないようにしています。
テキストボックスへの値の貼り付けが終了したら、２５５行目「EventOff = False」でフラグを寝かせます。

５－２－４．登録ボタン

操作ダイアログ下部の「登録ボタン」をクリックした時に呼び出されるのが図５－９です。

259. '==========　⇩(19)　登録ボタン　============
260. Private Sub CommandButton1_Click()
261. 　Dim Ans As Long 　　　 '←メッセージボックスの戻り値
262. 　Dim buf1 As Variant 　 '←会社番号で絞り込んだ結果
263. 　Dim buf2 As Variant 　 '←会社名で絞り込んだ結果
265. 　If Me.ListBox1.ListIndex = -1 Then 　 '←①+②
267. 　　If Trim(Me.TextBox1) = "" Or Trim(Me.TextBox2) = "" Then
268. 　　　MsgBox "会社番号または会社名が空です。" 　 '←①
269. 　　　Exit Sub
270. 　　End If
272. 　　Call TableFilterOff(TBL)
273. 　　Call TableFilter(TBL, 2, Trim(Me.TextBox1.Value))
274. 　　buf1 = SearchList(TBL)
276. 　　Call TableFilterOff(TBL)
277. 　　Call TableFilter(TBL, 3, Trim(Me.TextBox2.Value))
278. 　　buf2 = SearchList(TBL)
280. 　　If IsEmpty(buf1) = True Then 　 '←④+⑤
282. 　　　If IsEmpty(buf2) = False Then
283. 　　　　Ans = MsgBox("同じ社名の番号(" & buf2(0, 1) & ")が存在します。別登録をしますか？", vbYesNo) 　 '←⑤
284. 　　　　If Ans = vbNo Then Exit Sub
285. 　　　End If
286. 　　　Call DataUpdate(0, Trim(Me.TextBox1.Value), Trim(Me.TextBox2.Value)) 　 '←④+⑤
287. 　　　MsgBox "新規登録しました"
289. 　　ElseIf UBound(buf1, 1) = 0 Then 　 '←⑥+⑦
290. 　　　Ans = MsgBox("データを上書きしますか？", vbYesNo)
291. 　　　If Ans = vbNo Then Exit Sub
293. 　　　If IsEmpty(buf2) = False Then
294. 　　　　Ans = MsgBox("同じ社名の番号(" & buf2(0, 1) & ")が存在します。別登録をしますか？", vbYesNo) 　 '←⑦
295. 　　　　If Ans = vbNo Then Exit Sub
296. 　　　End If
298. 　　　Call DataUpdate(CLng(buf1(0, 0)), Trim(Me.TextBox1.Value), Trim(Me.TextBox2.Value)) 　 '←⑥+⑦
300. 　　Else 　 '←⑧
301. 　　　MsgBox "この会社番号は、既に複数あります。管理者に連絡下さい"
302. 　　　Exit Sub
303. 　　End If
305. 　Else 　 '←③
306. 　　MsgBox "データは修正されていません。"
307. 　　Exit Sub
308. 　End If
310. 　Call DataRead
311. 　Call DataPaste
312. 　Call TextBox1_Change
314. End Sub

図５－９

まず、どんな状況で登録ボタンが押されたか、またその時の処理内容を図５－１０にまとめます。

ListBoxの状態	TextBox1(会社番号)	TextBox2(会社名)	判断
リスト無し OR リスト有るが 選択状態で無い	×	×	①入力途中→そのまま
	〇	×
	×	〇
	〇	〇	②登録･修正工程へ
選択状態	〇選択中の会社番号	〇選択中の会社名	③間違ってｸﾘｯｸ→そのまま

図５－１０

条件はListBoxの選択・非選択、及び会社番号欄・会社名欄の状況です。今回システムが「会社番号・会社名のセットで１つのデータ」ということで成立しているため、会社番号欄・会社名欄のどちらか又は両方に文字列が入力されていない場合は、入力途中①ということになります。
また、中央部のリストボックスが選択状態の場合には「リストの項目を選択してから、まだテキストボックスで編集を行っていない」状態であり、その状態で「登録ボタン」をクリックするのは、リストにあるデータそのものを再登録しようとする意味の無い行為であり、間違えてクリックした時くらいだと思います。ですのでファイル処理はしない③事にします。

リストが選択状態では無く、両方のテキストボックスに文字列が入っている場合は、登録の処理の対象②となります。ちなみに、その入力方法としては以下が考えられます。
　・両テキストボックスに手入力で文字列を入れた。
　・リストを選択し、テキストボックスを編集した。
　・リストを選択し、テキストボックスを編集ようとしたが、元の値に戻した。→内容は③と同じ

どのような入力方法だとしても「ユーザーがデータを登録しよう」としていると見なしますが、データのチェックは必要で、登録しようとしている「会社番号」と「会社名」が既存のリストに存在するか否かで対応が異なってきます。その対応方法について図５－１１でまとめました。

		会社番号
		リスト中に存在せず	リスト中に1個存在	リスト中に複数存在
会 社 名	リスト中に 存在せず	④会社番号も会社名も新のため､ 新規登録可	⑥会社名を変更しようとしている	⑧異常と判断
	リスト中に 存在する	⑤同じ会社名を異なる会社番号で 登録しようとしている	⑦変えようとしている会社名は､ 既に別の会社番号として存在する

図５－１１

今回システムでは「会社番号は重複しない」ので図５－１１の１列目「リスト中に存在せず」はデータの新規追加、２列目「リスト中に1個存在」はデータ修正（上書き）、３列目「リスト中に複数存在」は異常事態となります。また、同じ会社名を異なる会社番号として登録するのは本来おかしいのですが、国の法人番号を見てみると、全く同じ会社名（もちろん法人番号は異なる）が全国にはいくつもあることが分かります。ですので今回は、ユニークな会社名を求めず、ユーザーに注意を促すぐらいに留めています。

この、図５－１０と図５－１１の「①～⑧の分岐と実行」をコード化したのが、図５－９になります。
まず２６５行目「If Me.ListBox1.ListIndex = -1 Then」で、リストボックスが選択状態か否かを調べ、選択状態（③：ListIndex ≠ -1）の場合は３０６～３０７行目を実行し、選択していない（①or②：ListIndex = -1）場合は２６７～３０３行目を実行します。

選択していない状態（①or②）の内、まずは「入力途中①」の状態を取り除くため、２６７行目「If Trim(Me.TextBox1) = "" Or Trim(Me.TextBox2) = "" Then」で、２つのテキストボックスの値を調べ、どちらかが空だった場合は２６８行目「MsgBox "会社番号または会社名が空です。"」でコメントを出し、２６９行目「Exit Sub」で処理を中止します。

これで、以下は②（登録可能）の状態ですので、２７２～２７４行目で「既存データを会社番号欄のワードで絞り込んだ結果」を、２７６～２７８行目で「既存データを会社名欄のワードで絞り込んだ結果」を取得します。
２７２行目「Call TableFilterOff(TBL)」で絞り込みをまず解除し、２７３行目「Call TableFilter(TBL, 2, Trim(Me.TextBox1.Value))」で「会社番号で絞り込み」をし、２７４行目「buf1 = SearchList(TBL)」でその絞り込み結果を変数buf1に代入します。
また、２７６行目「Call TableFilterOff(TBL)」で絞り込みを解除し、２７７行目「Call TableFilter(TBL, 3, Trim(Me.TextBox2.Value))」で「会社名で絞り込み」をし、２７８行目「buf2 = SearchList(TBL)」でその絞り込み結果を変数buf2に代入します。

まず、会社番号で絞り込んだ結果（buf1）の件数を調べます。絞り込んだ結果が1件も無ければ「buf1＝Empty」となりますし、インデックスはゼロ始まりなので、件数が1件であれば「Ubound(buf1,1) = 0」、2件であれば「Ubound(buf1,1) = 1」・・・となります。
２８０行目「If IsEmpty(buf1) = True Then」は会社番号で絞り込んだ結果が１つも無い場合（図５－１１の④⑤）です。この場合は２８２～２８７行目を実行します。２８９行目「ElseIf UBound(buf1, 1) = 0 Then」は１個の場合（図５－１１の⑥⑦）で、２９０～２９８行目を実行し、３００行目「Else」が複数個の場合（図５－１１の⑧）で３０１～３０２行目を実行します。

２８０行目「If IsEmpty(buf1) = True Then」は会社番号で絞り込んだ結果が１つも無い場合で、図５－１１の④⑤に該当します。その④と⑤を分離するために、２８２～２８５行目でユーザーに判断を求めます。
２８２行目「If IsEmpty(buf2) = False Then」は「会社名での絞り込み行数が１以上存在」する場合⑤です。この場合はユーザーに対して「同じ会社名を違う会社番号として登録」して良いか否かの判断を求めます。
２８３行目「Ans = MsgBox("同じ社名の番号(" & buf2(0, 1) & ")が存在します。別登録をしますか？", vbYesNo)」では、メッセージを表示します。このメッセージには「はい」「いいえ」の２つのボタンがあり、ユーザーの判断で分岐できるようにしています。またメッセージ内には「buf2(0, 1)」と、既に存在する（複数存在する場合は１番目の）会社番号も表示させます。
そのメッセージ上のどのボタンをクリックしたかを、２８４行目「If Ans = vbNo Then Exit Sub」で調べ、「いいえ（＝別登録をしない）」を選択した場合は処理を中止します。

ボタンの「はい」をクリックした時は、２８６行目「Call DataUpdate(0, Trim(Me.TextBox1.Value), Trim(Me.TextBox2.Value)」で、図４－８を呼出し、固定長ファイルにデータを書き込みます。
書き込むデータは、この場合「新規追加データ」になりますので「固定長ファイルの１番下の次行」となります。ですのでDataUpdateプロシージャに渡す第一引数「書込み位置」には「ゼロ」を渡し、DataUpdateプロシージャ内で計算した「１番下の次行」に書き込むことになります。
そして２８７行目「MsgBox "新規登録しました"」で、ユーザーに登録が完了した旨を伝えます。

２８９行目「ElseIf UBound(buf1, 1) = 0 Then」は会社番号で絞り込んだ結果が１つの場合で、図５－１１の⑥⑦に該当します。
ユーザーの判断を求めている部分は２ヶ所あり、２９０～２９１行目は⑥⑦共通、２９３～２９６行目は⑦の場合に実行されます。どちらを先に実行するかを考えてみると、この⑥⑦では「入力した会社番号は既に存在」することをユーザーに伝えるのが重要なことだと判断しました。例えば２９３～２９６行目を先に実行してしまうと、ユーザーは「同じ社名が存在」することをまず知り、結果「いいえ」をクリックしてしまうと、「入力していた会社番号は既に存在」することには気が付かないことになってしまいます。
ですので、今回はこの順番でユーザーに確認を取っています。

２９０行目「Ans = MsgBox("データを上書きしますか？", vbYesNo)」で、同じ会社番号として会社名を上書きして良いかを確認し、２９１行目「If Ans = vbNo Then Exit Sub」で回答が「いいえ」であれば処理を中止します。

２９３行目「If IsEmpty(buf2) = False Then」では、「会社名が１つ以上絞り込まれた（＝存在する）」場合に、２９４行目「Ans = MsgBox("同じ会社名の番号(" & buf2(0, 1) & ")が存在します。別登録をしますか？", vbYesNo)」で、ユーザーに対してメッセージボックスを表示します。表示内容には「buf2(0, 1)」と「同じ会社名の会社番号」を表示します。会社名自体は操作ダイアログのTextBox2に表示されているので会社番号側のみを表示しています。なお、２つ以上データが絞り込まれた場合は１番目（会社番号順）のデータのみの表示となります。
そしてユーザーが「いいえ（＝別登録をしない）」を選択した時には、２９５行目「If Ans = vbNo Then Exit Sub」で処理を中止します。

２９０行目のメッセージボックスで「データを上書きする」を選択し、２９４行目のメッセージボックスが表示されて「別登録をする」を選択すると、２９８行目「Call DataUpdate(CLng(buf1(0, 0)), Trim(Me.TextBox1.Value), Trim(Me.TextBox2.Value))」で図４－８を呼出し、固定長ファイルにデータを上書きします。
この場合は、既存データの上書きですので、書き込むための固定長ファイルの行位置が必要になります。上書きする既存データは、２７４行目で取得したbuf1値になりますので、そのbuf1の１列目のデータ（buf1(0, 0)）が固定長ファイルの行位置となります。なお、行位置はDataUpdateプロシージャ側ではLong型で要求していますが、buf1は２６２行目でVariant型で宣言していて合っていません。ですので、CLng関数でLong型に変換してから値を渡しています。

会社番号で絞り込んだ結果が複数個得られた場合は、３００行目「Else」以下が実行されます。今回システムでは、会社番号はユニーク番号（重複は無し）ですので、異常な状態です。ですので、３０１行目「MsgBox "この会社番号は、既に複数あります。管理者に連絡下さい"」でユーザーにコメントを出し、３０２行目「Exit Sub」で処理を中止します。
なお、この会社番号の重複が発生するとすれば、複数の担当者が同じ会社番号を同時に追加する場合です。テキストデータを一旦自分のテーブルに持ってきてから絞り込み作業を行っているため、どうしても書込みが重複してしまう可能性があります。防御としては書込み直前に再度読み込みを行って確認するくらいしか手が無く、それでも完璧ではありません。
もしデータ追加作業を複数人で行う場合は、重複しないように入力するデータを分けるとか、メンテナンスの担当業種を分けるなどの対策が必要と思います。

リストボックスが選択状態の場合は、３０５行目「Else」以下が実行されます。３０６行目「MsgBox "データは修正されていません。"」でコメントを出し、３０７行目「Exit Sub」で処理を中止します。
この状態は、リストボックスが選択状態であるということは、テキストボックスの値が変更されていない（＝テキストボックスのChangeイベントが働いていない）ために「テキストボックスの値＝既存データ」であるためです。データの上書き処理をしても良いですが、同じデータを上書きするだけですし、リストの絞り込みデータも「テキストボックスのデータで絞り込まれる」ために「１行のみのリスト」に置き換わってしまいます。

固定長ファイルへの書込みが終了したら、テーブルのデータを最新にし、且つ表示データを更新するため、３１０行目「Call DataRead」で図４－３を呼出し「固定長ファイルからデータを取り込み」、３１１行目「Call DataPaste」で図４－７を呼出し「テーブルにデータを貼り付け」、３１２行目「Call TextBox1_Change」で図５－６を呼出して「テキストボックスの検索ワードに従って絞り込みをし、その結果をリストボックスに表示」させます。

５－２－５．削除ボタン

操作ダイアログ下部の「削除ボタン」をクリックした時に呼び出されるのが図５－１２です。

316. '==========　⇩(20)　削除ボタン　============
317. Private Sub CommandButton2_Click()
318. 　Dim Ans As Long 　 '←メッセージボックスの回答
320. 　If Me.ListBox1.ListIndex = -1 Then
321. 　　MsgBox "リストを選択して下さい"
322. 　　Exit Sub
323. 　End If
325. 　Ans = MsgBox("選択中の項目を削除して良いですか？", vbYesNo)
326. 　If Ans = vbNo Then Exit Sub
328. 　Call DataUpdate(Me.ListBox1.List(Me.ListBox1.ListIndex, 0), "", "")
329. 　Call DataRead
330. 　Call DataPaste
331. 　Call TextBox1_Change
333. End Sub

図５－１２

３２０～３２３行目ではリストボックスを選択しているか否かをチェックしています。リストボックスが選択状態になっていれば、「固定長ファイル上に存在するデータが、テキストボックス上に表示されている」ことになり、「その表示されている項目が削除の対象」であることが明確に分かります。
３２０行目「If Me.ListBox1.ListIndex = -1 Then」では、リストボックスのListIndexを調べ、選択していない（-1の値）であれば、３２１行目「MsgBox "リストを選択して下さい"」でコメントを出し、３２２行目「Exit Sub」で処理を中止します。
なお「削除しようとしている項目」を、他の人が一瞬早く削除してしまう場合もあると思います。しかし今回システムで削除とは「会社番号と会社名の部分を空データにする」だけですので、「空データを空データで上書きする」ことになるので特に問題は無く、「既に削除済みです」等のコメントは用意していません。

リストボックスが選択状態の時には、３２５行目「Ans = MsgBox("選択中の項目を削除して良いですか？", vbYesNo)」でユーザーに再確認を行い、「いいえ（＝削除をやめる）」をクリックした時には３２６行目「If Ans = vbNo Then Exit Sub」が成立し処理を中止します。

削除を実行することを選択した時には、３２８行目「Call DataUpdate(Me.ListBox1.List(Me.ListBox1.ListIndex, 0), "", "")」で図４－８を呼出し、対象データの「会社番号と会社名の部分に、""（長さゼロの文字列）を書き込む」処理をします。
なお、削除する行位置は、リストボックスの選択行の１列目（インデックスはゼロ、非表示の列）のデータを使用します。

固定長ファイルへの書込み（＝データ削除）が終了したら、テーブルのデータを最新にし、且つ表示データを更新するため、３２９行目「Call DataRead」で図４－３を呼出し「固定長ファイルからデータを取り込み」、３３０行目「Call DataPaste」で図４－７を呼出し「テーブルにデータを貼り付け」、３３１行目「Call TextBox1_Change」で図５－６を呼出して「テキストボックスの検索ワードに従って絞り込みをし、その結果をリストボックスに表示」させます。

５－２－６．終了ボタン

操作ダイアログ下部の「終了ボタン」をクリックした時に呼び出されるのが図５－１３です。

335. '==========　⇩(21)　終了ボタン　============
336. Private Sub CommandButton3_Click()
337. 　Unload Me
338. End Sub

図５－１３

３３７行目「Unload Me」で、自分（＝UserForm1）を閉じます。Hideメソッドでは無くUnloadステートメントを使い、メモリー上からフォームを削除しますので、再起動時は図５－３のInitializeイベントからスタートすることになります。

３３７行目の Unload me を実行すると、実はフォームが閉じる前に図５－１４のQueryCloseイベントが発生します。そしてQueryCloseイベントが終了した時点でフォームが無くなります。
また、フォームの右上×印をクリックしてフォームを閉じた時にもQueryCloseイベントが発生します。
なお、Me.Hideでフォームを閉じた（＝隠した）時には、QueryCloseイベントは発生しません。

340. '==========　⇩(22)　システム終了　============
341. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
342. 　TBL.Delete
343. End Sub

図５－１４

３４２行目「TBL.Delete」で、ワークシート上のListObject（テーブル）を削除します。削除と共に、シート上のデータは全て無くなります。
なお、もし固定長ファイルの中身を確認する必要が出てきたら、操作ダイアログが起動している内にテーブルのデータを確認するか、または３４２行目をコメントアウトしてから閉じるればテーブルのデータが残ります。また、テーブル名を変更しないのであれば、３４２行目は無効にしてもOKです。
但し、テーブルを残してシステム終了した状態でテーブル名を変更すると、次回起動時に新規にテーブルを作成する段階で、元の名前のテーブルが残っている事になるのでエラーが出ます。ご注意下さい。

５－２－７．絞り込みリストの作成

操作ダイアログのテキストボックス（図５－６）の２４１行目から呼び出されるのが図５－１５です。引数としてテーブルのオブジェクトを受け取ります。
テーブルを絞り込んだ結果を見て、絞り込み件数の表示とリストボックスへのデータ表示を行っています。

345. '==========　⇩(23)　絞り込みリストの作成　============
346. Sub makeList(T As ListObject)
347. 　Dim cnt As Long 　　 '←絞り込みデータの行数
348. 　Dim buf As Variant 　 '←絞り込みデータの配列
349. 　Dim i As Long 　　　 '←リストの行数
351. 　On Error Resume Next
352. 　　cnt = Int(T.DataBodyRange.SpecialCells(xlCellTypeVisible).Count / 3)
353. 　On Error GoTo 0
354. 　Me.Label1.Caption = cnt
356. 　Me.ListBox1.Clear
357. 　If cnt > 100 Then Exit Sub
359. 　buf = SearchList(T)
360. 　If IsEmpty(buf) = True Then Exit Sub
362. 　For i = 0 To UBound(buf, 1)
363. 　　Me.ListBox1.AddItem ""
364. 　　Me.ListBox1.List(i, 0) = buf(i, 0)
365. 　　Me.ListBox1.List(i, 1) = buf(i, 1)
366. 　　Me.ListBox1.List(i, 2) = buf(i, 2)
367. 　Next i
369. End Sub

図５－１５

３５２行目「cnt = Int(T.DataBodyRange.SpecialCells(xlCellTypeVisible).Count / 3)」では、絞り込まれたテーブルのデータ行数を計算し、変数cntに代入しています。データ行数は単純には求められないのですが、「表示状態になっているセル数」は「ListObject.DataBodyRange.SpecialCells(xlCellTypeVisible).Count」で求められますので、その値を「列数で割った値」が「絞り込まれたデータ行数」となります。念の為、Int関数で小数点の出ないようにしています。

また１行も表示状態になっていない状態ではエラーが発生してしまいますので、３５１行目「On Error Resume Next」でエラーをスルーさせるようにしています。エラーが発生した時は、３５２行目は計算されませんので、変数cntは初期値のゼロとなります。
３５４行目「Me.Label1.Caption = cnt」では、その求められた変数cnt値を操作ダイアログのラベル（絞り込み数）に表示します。

３５６行目「Me.ListBox1.Clear」では、リストボックスのデータをクリアします。
３５７行目「If cnt > 100 Then Exit Sub」では、絞り込み行数cntが100件を超えていた時に、このプロシージャを抜け出します。
「100件を超えていた時」としたのは、あまりにもリスト件数が多い状態は、絞り込んだとは言えないと思いますし、またリスト上にデータを並べるにも処理時間が掛かってしまいます。但し100件が妥当か否かは、使う環境により異なると思います。

３５９行目「buf = SearchList(T)」では図４－１７を呼出し、絞り込みデータを配列として取得し、配列bufに代入します。
３６０行目「If IsEmpty(buf) = True Then Exit Sub」では、取得したbufがEmptyだった（＝絞り込まれたデータ行がゼロだった）ときに、リストデータを作成せずに抜け出します。
なお、３５７行目を「If cnt > 100 Or cnt = 0 Then Exit Sub」とし「行数がゼロだったら、すぐに抜けてしまう」方法にすれば、３６０行目は不要となります。但し、万一変数bufがEmptyになってしまったら３６２行目でエラーが出てしまうので、私としては３６０行目の「If IsEmpty(buf)・・・」は残したい気持ちです。

３６２～３６７行目ではリストボックスにデータを作っています。
３６２行目「For i = 0 To UBound(buf, 1)」で、カウンタ変数ｉを絞り込みデータ行数分だけ回しています。なお、配列bufのインデックスはリストボックスに貼り付け易いように、図４－１７内でゼロ始まりの配列にしています。
今回のリストボックスは複数列（3列）仕様としていますので、まず３６３行目「Me.ListBox1.AddItem ""」で、空の行を作成します。その作成した空の行の１列目（インデックス＝ゼロ）に、３６４行目「Me.ListBox1.List(i, 0) = buf(i, 0)」で絞り込みデータの１列目（インデックス＝０）の値（ファイルの行位置）を入れます。
続けて、３６５行目「Me.ListBox1.List(i, 1) = buf(i, 1)」で２列目の値（会社番号）、３６６行目「Me.ListBox1.List(i, 2) = buf(i, 2)」で３列目の値（会社名）を入れていきます。

６．ワークシート（Sheet1）

固定長ファイルから読み込んだデータは３列のデータとしてSheet1に書き込まれ、ListObject（テーブル）として管理し絞り込み等を行います。テーブルのタイトルからテーブル名設定まで全てマクロ側から行いますので、Sheet1に対して今回準備しておく事は「Sheet1が存在する」ようにするくらいです。

図６－１

なおワークシートに、行数の多いデータを一度貼り付けてしまうと、データを消してもExcelのファイルサイズが大きくなったままになります。元のデータがあった全行を「行削除」すると、サイズが小さくなります。

７．アドインとしてExcelにマクロを登録

このマクロ付ファイル（サンプルファイル）をExcelのアドインに登録することで、今回の「会社番号検索システム」を利用することが出来ます。アドイン方法については「年賀状リスト等の宛名検索と追記　アドイン登録」を参照下さい。
また、リボン上のボタンには、図４－２の「CoSearch」プロシージャをマクロ登録して下さい。

８．最後に

「ToDoリストで個人タスク管理」で少し懲りて、「ListObjectは暫く使わない」と思っていましたが、簡単に絞り込みが出来るのと併せ、絞り込み後のデータを配列に落とす仕組みで新たな方法を思いついた事から、再びListObjectの世話になることになりました。弱点があってもメリットの大きなものは、その弱点を把握した上で注意して使用した方が効率は良くなると思います。

また、データ絞り込みのワード入力と検索結果表示、及びデータ修正・新規入力を全て「会社番号・会社名の２つのテキストボックス」で行う仕様にしたので、絞込みリストの項目を選択後、会社番号または会社名を編集すると「保有データには無い新たなデータが入力された」と判断し、「絞込みリストが消えてしまう」ことになります。
ここまでは仕方がないと思いますが、編集したデータを登録したあと、また検索を最初からやり直さなければなりません。これは、ちょっと面倒です。

対策として「ユーザーが手入力したワードは残しておき、ある時点で復活させる」という手法も試してみたのですが、作業の順番によっては「検索テキストボックスのワード ≠ 絞込みリスト」という非整合の現象が発生してしまうことが分かりました。１つの枠に複数の機能を持たせたデメリットが露見したことになります。しかし、入力枠・出力枠を機能別に細かく分けてしまうのもユーザーにとって使い難くなると思うので、難しいところです。


会社番号検索システム（it-076.xlsm）
会社番号データ（Company.dat）

システムの入ったExcelファイルのみでも使用可能です。Excelファイル起動時にデータファイルは自動的に作成されます。 なお、会社番号データ（ある県の実際の法人番号の一部）を使用する場合は、とりあえずExcelファイルと同じ場所に保存して下さい。

セキュリティ向上を目的として「インターネット経由でダウンロードしたOfficeファイル（Excel等）のマクロは、既定でブロック」されるようにOfficeアプリケーションの既定動作が変更になりました。（2022年4月より切替開始） 解除の方法については「ダウンロードファイルのブロック解除方法」を参照下さい。