VBA タイムスタンプからユニークキーを生成する。

Excelでレコードごとにユニークキーが欲しくなることがある。

ユニークキーとは、一意にアイテムを特定でき、変わることのないコードのことで、数桁の数値や文字列で表現される。
実用上は単純な連番でも全く問題ない。

ただ以下のようなシチュエーションで連番が崩れたときに、何となく気持ち悪い。

項目の削除で欠番が発生したとき
後からアイテムを挿入した時

人間心理としては、改めて1から番号を連番で振り直したくなるものである。
そして実際に振り直してしまう人が多いが、実はこれ、やってはいけないアンチパターンである。

もう一度いう。ユニークキーとは、一意にアイテムを特定でき、変わることのないコードである。
あるアイテムをX番だとして覚えておく。これでアイテムの名称変更があってもX番を参照すれば良い。
それさえ管理すれば安心安定のキー。絶対的に信頼できる唯一のフィールド。
それが、変わる。。だと！？もはや何も信じられない。

とはいえ、綺麗に1番からカウントされてる以上、オーダーが崩れたら気になるというのはとてもよく分かる。

どうすれば良いか。結構長いこと悩んでいたのだが、最近画期的なアイデアがひらめいた。

要するに綺麗な連番を採用するから気になるのであって、最初から意味不明なコードをユニークキーに使えば順番がバラバラだろうが何だろうが気にならなくなる！

そこで今回は、パッと見て意味が分からないユニークキーをVBAで生成してみようと思う。

今回生成するユニークキーの外観

たとえば、2019/02/19 0:59:40に生成したひとつ目のユニークキーは「XKR_2RG#0」である。
この英数字+記号の9文字で、年月日時分秒+重複に備えた連番を表すことができ、その気になれば元の日付にデコードもできる。
※今回デコード用のコードは用意してません。

前置きが長くなったけど、ここから実行結果とコードと解説

VBAコード

※コードのうち、奇数変換部分は以下の記事のものを流用させていただきました。ありがとうございます。
※流用の際、一部識別子名を変えてます。
hex309.hatenablog.com

Sub TestGetUniqueKey()
    Debug.Print Now
    Debug.Print GetUniqueKey
    Debug.Print GetUniqueKey
    Debug.Print GetUniqueKey
    
    '連番部分がリセットされることを確認するために1秒待つ
    Application.Wait Now() + TimeValue("00:00:01")
    Debug.Print Now
    Debug.Print GetUniqueKey
    Debug.Print GetUniqueKey
    Debug.Print GetUniqueKey
End Sub

Function GetUniqueKey() As String
    Static n As Long
    Static storedStamp As String
    Dim timeStamp As String
    timeStamp = _
        RadixConversion(CLng(Date), 36) & "_" & _
        RadixConversion(Hour(Time) * 60 ^ 2 + Minute(Time) * 60 + Second(Time), 36)

    If storedStamp = timeStamp Then
        n = n + 1
    Else
        n = 0
    End If
    
    storedStamp = timeStamp
    GetUniqueKey = timeStamp & "#" & n
End Function

Public Function RadixConversion(ByVal num As Long, ByVal Radix As Long) As String
    Dim Quotient As Long
    Dim Remainder As Long
    Dim Answer As String
    Quotient = num
    Do
        Remainder = Quotient Mod Radix
        Quotient = Quotient \ Radix
        Answer = GetNumChar(Remainder) & Answer
    Loop Until Quotient = 0
    RadixConversion = Answer
End Function

Private Function GetNumChar(ByVal num As Long) As String
    Dim temp As Variant
    temp = Split("0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z")
    GetNumChar = temp(num)
End Function

実行方法

TestGetUniqueKeyを実行するとイミディエイトウインドウにキーが3つ出力され、1秒後に続いてキーが更に3つ出力される。

例)

2019/02/19 1:24:42 
XKR_3X6#0
XKR_3X6#1
XKR_3X6#2
2019/02/19 1:24:43 
XKR_3X7#0
XKR_3X7#1
XKR_3X7#2

解説

まず日付は桁数を減らすためにCLng関数でシリアル値に変換している。

前提として、VBAでは日時データをシリアル値というDouble型の内部データで管理している。
試しにイミディエイトウインドウに「?now;vbnewline;cdbl(now)」と入力してみると、現在日時とそれをダブル型で表した数値が表示される。

2019/02/19 1:07:54 
 43515.0471527778

このとき整数部分が日付を表す。(上の例でいうと43515が日付を表し、1899/12/31からの経過日数である。)
秒まででよければ少数部は逆に、010754と6桁で表した方が桁が少ないので、ここでは日付部分だけシリアル値を採用する。

そして日付シリアル値を1～Zまでの英数字を使って36進数で表すと2019年現在、3桁に収まる。
たとえば本日2019/2/19は、XKRである。

次に0時からの経過秒数を求め、これも36進数に変換する。
試しにイミディエイトウインドウに「?time;vbnewline;Hour(Time) * 60 ^ 2 + Minute(Time) * 60 + Second(Time)」と入力してみると、現在時刻と0時からの経過秒数が表示される。

1:17:06 
 4626

一日は24時間なので最大値は「?24*60^2」で求まり、86400である。235959と比べて1桁少なく済む。
さて、4626を36進数に直すと、「?RadixConversion(4626,36)」で3KIと出た。

これをつなげてXKR_3KIとする。
さらに秒まで重複したときのために、末尾に#と連番を付加する。

具体的には、ユニークキーを得る関数GetUniqueKey内部で、Static変数storedStampにタイムスタンプを記録しておき、次の呼び出し時に変化が無ければStatic変数nを加算する。タイムスタンプが変化したらnをリセットすることで連番nを制御している。

おわりに

実質連番なのである程度の規則性は出てしまうけど、綺麗に1～並んでるよりは、欠番とかソート順とかが気にならなくなる。
これなら振り直したり、しないよね？

ちなみに今回のマクロは基本的におひとり様もしくは排他制御下で使うことが前提。
複数名が同時に振り出すようなシチュエーションではキーの重複もあり得るので、そのような場面には適用しないように注意。

以上

t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA タイムスタンプからユニークキーを生成する。

今回生成するユニークキーの外観

VBAコード

実行方法

解説

おわりに