category name  »  page title date

データ構造をセルに保管

ある種の構造化されたデータを、まるごと単一のセルに保管したいことがあります。
たとえば、図のごとし。

A-a のセルをダブルクリックすると、A-a に該当する名前、住所、電話番号、メイルアドレス、生年月日などが表示され、編集も行える、などということが可能になれば、いろいろと応用ができます。この緑色のセルは、色が異なっていてもよいし、それぞれがカレンダーの年月を表わしていてもいいでしょう。個々のデータの形式は、文字でも数値でも日付でもよいようにしたい。

そこで考えたのは、それぞれのデータをデリミタを介して一つながりの文字列にし、セルに格納することです。文字の色をセルの背景色と同じにしておけば、直接見えないようにできます。そのセルをダブルクリックすると、Split 関数によって元のデータを復元することができます。
デリミタには、データ内の文字と競合しないように、ASCIIコードの中で通常は使用しないレコード区切り(RS)の"30"を使うことにしました。

ところで、単一のセルに格納できる文字数には上限があるのではないか、という心配があります。そこで、セル内に1万文字、2万バイトを流し込んでみたところ、何も起こりませんし、きちんと読み取ることもできることを確認しました。仕様や環境によってどこかに上限はあるでしょうが、通常の用途ではまったく問題はなさそうです。

全体の構成は、こうすればよいのではないでしょうか?
表示したり編集したりするためのユーザーフォームを、NoteForm として用意します。
ワークシートは、上の図のようなものがあるとします。
ユーザーフォームとワークシートとの間を NoteClass のインスタンス Note が取り持ちます。
ワークシート上で特定の(色のついていない)セルをダブルクリックすると、そのセルに記載された word が Note によって分割されて各プロパティに格納され、各プロパティが NoteForm に表示されます。
NoteForm の内容が変更されて OK ボタンが押されると、その内容が Note のプロパティに転送され、さらに word に変換されて元のセルに格納されます。

Note を介さないで直接 word と NoteForm がやりとりすればすっきりするようですが、途中に Note を噛ませることで、データの集計(その時、NoteForm はいらない)やデータのコピー(その時、word はいらない)など、機能を拡張していく際に見通しが立てやすくなります。

NoteForm としては、こんなのを用意しました。赤字で注記したのは、各コントロールの名称です。

プログラムコードは、ワークシートのダブルクリックイベントの処理と、ユーザーフォームのイベント処理、それに NoteClass のインスタンス Note をパブリックなオブジェクトとして定義するための標準モジュール(NoteModule)と、本体の NoteClass のコードが必要となります。
以下に、それぞれ例示しておきました。これは、いわば骨格となるものです。必要に応じて変数名の変更や、エラー処理の追加、拡張機能の追加などを行うと、より実用的なものになるでしょう。

ワークシート

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      '色のついていないセルだと、何もしない
      If Target.Interior.Color = &HFFFFFF Then Exit Sub
      'Note インスタンスの取得
      If Note Is Nothing Then Set Note = New NoteClass
      'NoteForm の表示
      NoteForm.Show vbModeless
      Cancel = True
End Sub

ユーザーフォーム         NoteForm

'----- OKボタンによる処理
'フォームの内容を Note を介してセルに書き込む
Private Sub CommandButton_Click()
      Note.FormToNote
      Note.NoteToWord
End Sub
'----- Form が起動された時の処理
'該当セルを Note に渡して、その内容をフォーム上に表示する
Private Sub UserForm_Activate()
      Note.WordToNote Selection
      Note.NoteToForm
End Sub

標準モジュール         NoteModule

'----- NoteClass のインスタンス
Public Note As NoteClass

クラスモジュール         NoteClass

'----- Word 内の区切り文字
Const SepCode = 30
'----- クリックされたセル
Private cell
'----- プロパティ―
Private item0
Private item1
Private item2
Private item3
'========== Word <--> Note
'----- セル内の Word を分解して Note のプロパティ―に転送
Public Sub WordToNote(target)
Dim words
      Set cell = target
      'word が未定義の場合の事前処理
      If Len(cell.Value) = 0 Then NoteToWord
      '定義済みの場合
      words = Split(cell.Value, Chr(SepCode))
      item0 = words(0)
      item1 = words(1)
      item2 = words(2)
      item3 = words(3)
End Sub
'----- Note のプロパティ―をまとめて Word に変換してセルに格納
Public Sub NoteToWord()
Dim word
      word = Join(Array(item0, item1, item2, item3), Chr(SepCode))
      With cell
            .Value = word
            '文字色をセルの背景色にする
            .Font.Color = .Interior.Color
      End With
End Sub
'========== Note <--> NoteForm
'----- Note のプロパティ―を NoteForm に表示
Public Sub NoteToForm()
      With NoteForm
            .Item0TextBox.text = item0
            .Item1TextBox.text = item1
            .Item2TextBox.text = item2
            .Item3TextBox.text = item3
      End With
End Sub
'----- NoteForm の内容を Note のプロパティ―に転送
Public Sub FormToNote()
      With NoteForm
            item0 = .Item0TextBox.text
            item1 = .Item1TextBox.text
            item2 = .Item2TextBox.text
            item3 = .Item3TextBox.text
      End With
End Sub


ところで、最初に示した画面では、対象とするセルに文字をいれることができません。セル内の文字そのものをデータとしているから当然ですね。
これでは、ちょっと不便だというケースもありえます。その時には、セル自体に名札をつけるのではなく、セルの上にテキストボックスを配置して、そこに名前をいれておくことにしましょう。

たとえば、こんな感じ。
この例では、12個のセルにそれぞれ名前を記載したテキストボックスを配置して、すべてのテキストボックスに同じ ClickText というマクロを登録してあります。

ClickText マクロは、標準モジュールにいれておきます。
これは、ワークシートに記載していたイベント処理ルーチン(Worksheet_BeforeDoubleClick)をちょっと改竄したもの。クリックされたテキストボックスの配置されたセルを調べて、さっきの例でいえばそのセルがダブルクリックされたと同じ処理を行います。
「佐藤さん」のセルをクリックすると(実際にはセルではなくテキストボックスなのですが)、佐藤さんのフルネイム、所属、生年月日、住所、連絡先・・・・といった情報が表示され、その編集を行うことができます。

標準モジュール         NoteModule

'----- NoteClass のインスタンス
Public Note As NoteClass
'----- テキストボックスから呼び出すマクロ
Public Sub ClickText()
Dim target
      'クリックしたテキストボックスが配置されているセルを取得
      Set target = ActiveSheet.Shapes(Application.Caller).TopLeftCell
      '色のついていないセルだと、何もしない
      If target.Interior.Color = &HFFFFFF Then Exit Sub
      'Note インスタンスの取得
      If Note Is Nothing Then Set Note = New NoteClass
      target.Select
      'NoteForm の表示
      NoteForm.Show vbModeless
End Sub