iso tank 2019年

＜2019-11-25 修正あり＞

VBAにおける文字列型変数には可変長文字列と固定長文字列があり、以前の記事で触れたMidステートメントを利用した文字列結合は、可変長文字列を使用している。

ところで、Microsoftのリファレンスにはこんなことが書いてある。

「Micsoft Docs - スタック領域が不足しています (エラー 28)」より抜粋

スタックとは、実行中のプログラムの需要に応じて動的に増減されるメモリの作業領域です。 このエラーの原因と解決策を以下に示します。

• （中略）
• 固定長の文字列が多すぎます。プロシージャ内の固定長文字列は、より迅速にアクセスできますが、文字列データそのものがスタックに配置されるため、可変長文字列よりも多くのスタックスペースを使用します。（以下略）

固定長文字列はスタック領域に文字列リテラルを格納するため、可変長文字列より高速にアクセスできるらしい。確かに文字列の長さが固定であれば、文字列リテラルを格納するメモリ領域を変える必要がない＝アドレスを固定できるので、参照型であることを辞め数値型などの他の値型と同様、スタック領域に直接データを保持するようにすれば、パフォーマンスの向上が図れるだろう。

ところが実際に固定長文字列と可変長文字列の二つの変数に単純な代入や簡単な（LeftやReplaceや結合などの）文字列操作等を行わせて処理速度を比較すると、固定長文字列が可変長文字列に処理速度で勝ることは少ない。

その上固定長文字列には最大65,526文字という上限があるし、他にも様々な制約がある。

もっとも、固定長文字列の使い方を自分が熟知していないというだけであって、少なくとも自分の今の使い方では固定長文字列をパフォーマンス向上に使うことができない、ということだろうと思う。よし。なんだか分からんけど使えないってことでいいや。終わり。

…とは言え、単純な代入ですら可変長文字列より固定長文字列の方が遅い原因が分からずにモヤモヤしたままでいるのも嫌だったので、自分なりに検証・予想してみた。

Microsoft公式で書かれていることが正しければ、固定長文字列はスタック領域に文字列を直接格納しているはずであり、もしそうなら公式に書かれているとおり「より迅速にアクセスできる」はずなのだ。検証するために先の記事で書いたメモリダンプ（DumpString・DumpMemory）を利用して固定長文字列のメモリをダンプしてみたら、なんだか不思議なことになった。

Dim str As String * 8
Dim i As Long
Let i = 2147483647                      'Long型の最大値(0x7FFFFFFF)
Let str = "一二三四五六七八"
Debug.Print "参照:" & vbCrLf & " " & Hex$(VarPtr(str)) _
          & "-> " & Hex$(VarPtr(ByVal str))
Debug.Print vbCrLf & "スタックのダンプ(24byte):"
Call DumpMemory(VarPtr(str), 8)         'スタック領域(4byte)
Call DumpMemory(VarPtr(str) + 8, 16)    'スタック領域(16byte)
Debug.Print vbCrLf & "ヒープのダンプ(16byte):"
Call DumpMemory(StrPtr(str), LenB(str)) 'ヒープ領域

参照:
 E0E9B4-> 11B6AD8C →なぜかスタックのアドレスがずれる

スタックのダンプ(24byte):
 E0E9BC   8C AD B6 11 FF FF FF 7F  0x11B6AD8C →ヒープのアドレス…のはず。 0x7FFFFFFF →変数iの中身
 E0E9C4   00 4E 8C 4E 09 4E DB 56  一二三四   →スタックに格納された文字列リテラル
 E0E9CC   94 4E 6D 51 03 4E 6B 51  五六七八

ヒープのダンプ(16byte)：
 11B6AECC 00 4E 8C 4E 09 4E DB 56  一二三四   →スタックに格納されたアドレスと異なる
 11B6AED4 94 4E 6D 51 03 4E 6B 51  五六七八

VarPtr関数で取得したアドレスに格納されたデータをダンプすると、まず最初の4バイトにヒープへのアドレスらしきデータが見受けられる。だが、StrPtr関数で取得したヒープ領域のアドレスとは異なる。そして次の4バイトは長整数型変数iのデータ(0x7FFFFFFF＝2147483647)があり、更にその先に文字列リテラルが格納されている。つまり、「ヒープ領域のアドレス（と思わしきもの）が格納されている領域」と「文字列リテラルが格納されている領域」は必ずしも隣接しておらず（他のデータが間に入っている）、一連のデータではない。自作のDumpStringでスタックとヒープを出力すると、スタック領域に格納されたヒープ領域のアドレスとStrPtr関数が指し示すアドレスは整合する。そして、VarPtr関数・StrPtr関数・DumpMemoryなどでアクセスするたび、スタック領域に格納されたヒープ領域のアドレスが変動する。

まとめると以下のとおり。

• スタック領域に文字列リテラルが見受けられるが、VarPtr関数で取得したアドレスはそこに行き着かない。
• VarPtr関数の結果（スタック領域のアドレス）がなぜか変わる。
• VarPtr関数で取得したスタック領域のアドレスには、スタック領域に格納されたヒープ領域のアドレスが入っている。
• StrPtr関数で取得するヒープ領域のアドレスは毎回変わる（文字列型以外の変数をStrPtrしたときと同じ）。
• なぜか可変長文字列を使ったときよりパフォーマンスが悪い。

色々考えたが、VarPtr関数では固定長文字列のスタック領域のアドレスを取得できないのではないか、という予測を立てた。そもそもVarPtr・StrPtr・ObjPtr関数自体が隠し関数であり、動作が保証されているものではない。StrPtr関数は渡された変数を可変長の文字列型とみなす（ヒープ領域に値がない場合は値をヒープ領域に格納する）ので固定長文字列をヒープ領域に格納し直すのはわかるが、VarPtr関数もまた固定長文字列を正しく処理できず（あるいは可変長文字列と固定長文字列の区別がつかず）、可変長文字列と同じデータ構造に一時的に変換しているのではないか。つまり以下のようなイメージだ。

DumpMemory・DumpString関数の結果がおかしくなるのも、引数に渡された固定長文字列が可変長文字列に都度変換されているからだと思われる。Functionステートメント、Subステートメントの説明にあるとおり、引数に指定できる文字列型は可変長文字列のみであり、またDeclareステートメントの注意書きにあるとおり、固定長文字列を渡しても可変長文字列に変換されているのだろう。つまり、固定長文字列のままプロシージャの引数に渡すことはできないということであり、これはユーザー定義のプロシージャに限らない、ということではないか。

以上のことから考えるに、固定長文字列は構造的にパフォーマンスが高いはずだが、大部分のステートメントや組み込み関数等が可変長文字列を前提としているため、ことあるごとに暗黙的に可変長文字列に変換されてしまい、結果として可変長文字列よりパフォーマンスが落ちているのではないだろうか。

もしそうだとすると、Midステートメントとの相性がいいのも頷ける。

'置換処理速度の比較（200万回繰り返し）
Dim src As String
Let src = "〇一二三四五六七八九十"
    
'可変長文字列の場合
Dim dst As String

'固定長文字列の場合
Dim dst As String * 11

'Replace$関数による置換
Let dst = Replace$(src, "十", "P")

'Midステートメントによる置換
Let dst = src
Let num = InStr(src, "十")
If num > 0 Then
    Mid(dst, num) = "P"
End If

表の上段の結果のとおり、Replace関数などの文字列操作関数や代入（Letステートメント）では、固定長文字列のパフォーマンスは落ちる。まず、Letステートメントは「データの総入れ替え」なので、固定長文字列であっても可変長文字列と同様にすべての文字列が入れ替わるという点では、固定長文字列にアドバンテージはない。他にそれぞれで行われる処理としては、可変長文字列の場合は①文字列の手前4バイトに文字列長を格納、②文字列末尾2バイトにヌル終端文字列を格納、③スタック領域に参照先を格納。固定長文字列の場合は①文字列が領域より長い場合は文字列を切り捨て、②文字列が領域より短い場合は空白を挿入。もしかすると固定長文字列に限り更に何らかのひと手間（データ構造の変換またはデータ移動等）があり、文字列リテラルの格納に手間がかかっている、ということもあるかもしれない。

加えて、上記のコードではInStr関数の引数に可変長文字列を指定しているが、実はここを固定長文字列に変えると処理が遅くなる。先述のとおり文字列操作系の関数が固定長文字列を想定しておらず、引数に指定された固定長文字列を一旦可変長文字列と同じデータ構造に変換している、などといった手間が生じていると思われる。

つまり、固定長文字列を普通に使用したのでは、読み込み（関数の引数）にも書き込み（Let）にも何かしら手間が生じパフォーマンスが低下してしまう。

他方、Midステートメントによる置換では、固定長文字列に分がある。参照型である可変長文字列と異なり、固定長文字列はスタックに直接文字列リテラルを保持しているので、メモリ領域の文字列を直接置き換えるMidステートメントではその差が現れるのだろう。

言い方を変えれば、Midステートメントは文字列操作関数やLetステートメント等とは違い（可変長文字列への変換等を行わず）、スタック領域に格納されている文字列リテラルを直接変更しているのだと思う。

つまり、使い方次第で固定長文字列の本来のパフォーマンスを引き出すこともできる。

が。

結局のところ、以前書いた漢数字変換関数などには固定長文字列を使わなかった。

固定長文字列の宣言（Dimステートメント）の文字列長の指定は定数式でなければならない、つまりあらかじめ決め打ちしておく必要があるし、コードの途中で文字列長を変えることもできない。定数式に関しては定数を増やせばいいがこれ以上増やしたくなかったし、コードの柔軟性とか固定長文字列にできる変数とすべきでない変数の選別とかパフォーマンスの検証とかなんかそういうのを考えて導入しなかった。

まとめ - VBAにおける固定長文字列

• 文字列が直接スタック領域に格納される（数値型やブール型等と同様）。
• 最長65,526文字まで（スタック領域を食い潰すので注意）。
• ユーザー定義のプロシージャや組み込み関数の引数に固定長文字列のまま指定することはできず、可変長文字列に変換される（このためVarPtr関数の引数に固定長文字列を指定しても正しいアドレスを取得できない）。
• プロシージャの戻り値の型に固定長文字列を指定することもできない（Property Get、Functionなど）。
• 可変長文字列と同じ扱い方で固定長文字列を扱うと、パフォーマンスが落ちる傾向がある。
• Midステートメントのように直接アクセスするなど、扱い方次第では可変長文字列より早くなる。
• 文字列長は定数式（定数またはリテラル）で指定しなければならないので注意すること。

2019-11-15 追記

なお、上記記事やこれまでのVBA関係の記事は32ビットOffice環境を前提としている。

2019-11-21 追記

画像とまとめを追記。

2019-11-25 修正

画像が誤っていたため差し替え。

＜2019-11-19 修正あり＞

先日公開したVBAの漢数字変換関数だが、最後の方に書いたとおり、文字列結合を&演算子でなくMidステートメントに置き換え、パフォーマンスの改善に挑戦してみた。

一般的（？）には馴染みが薄い手法で、自分もしばらくしたら忘れそうだ（というかちょっと忘れてた）ので、備忘録を兼ねて記事にしておく。

Midステートメントの要点

1. 擬似的な文字列結合を実現できる。
2. 一般的な&演算子による結合＋代入より速い。
3. 処理を遅くする要因に注意する。
   1. ヒープ領域を確保する処理
   2. 文字列を隙間なく敷き詰める処理
4. 「代入回数を減らせる」という強みを徹底的に生かすこと。
5. 使えるか使えないかは、よく見極めること。

おまけ

• 少なくとも自分の環境ではFormat$関数が非常に遅い。

1.Midステートメントを利用した疑似的な文字列結合

VB系では基本的に文字列は不変である。これはメモリ上の話で、ようするに「あるメモリ領域（アドレス）に格納された文字列は基本的に変更しない」ということであり、このため、変数に始めて文字列を格納する場合も、格納された文字列を変更する場合も、内部的には以下のまったく同じ動作を行っている。ついでに2つほど実験してみよう。

1. 一連の文字列（リテラル）を作成する（式または関数等が使用されている場合、すべて文字にする）。
2. ヒープ領域に、作成した文字列が入るだけの空きスペースを確保し、文字列を格納する。
3. スタック領域に、文字列の先頭アドレスを格納する。

'実験1：変数のアドレスを調べる
Sub AddressCheckTest()
    Dim n As Long
    Dim s As String
    
    '数値型の場合           出力結果
    Let n = 0
    Debug.Print VarPtr(n) '   6155024 ←スタック領域のアドレス
    Let n = n + 123
    Debug.Print VarPtr(n) '   6155024 ←値を変えてもアドレスは同じ
    
    '文字列型の場合
    Let s = "abc"
    Debug.Print VarPtr(s) '   6155020 ←スタック領域のアドレス
    Debug.Print StrPtr(s) ' 324132324 ←ヒープ領域のアドレス（文字列実体）
    Let s = s & "def"
    Debug.Print VarPtr(s) '   6155020 ←文字列を変えてもスタック領域のアドレスは同じだが…
    Debug.Print StrPtr(s) ' 324132284 ←ヒープ領域のアドレスが変わっている
    Let s = Left$(s, 2)
    Debug.Print StrPtr(s) ' 324132084 ←文字を削っても変わる
    Let s = "ghi"
    Debug.Print StrPtr(s) ' 324133044 ←同じ文字数の別の文字列に入れ替えても変わる
    Let s = "ghi"
    Debug.Print StrPtr(s) ' 324131884 ←同じ文字列を再度代入しても変わる
End Sub

変数に実際どのようにデータが格納されているのかを調べるため、mima_ita氏のブログ「実験ぶろぐ（仮）試供品」の、Excel VBAでメモリをダンプしてみる記事のコードを参考にさせていただいた。

'実験2：変数の中身を調べる
Private Declare Function RtlMoveMemory Lib "kernel32.dll" _
    (ByVal vDst As Any, ByVal vSrc As Any, ByVal vLen As Long) As Long

Sub DumpTest()
    Dim s$
    Let s = "〇一二三四五六七八九十"
    Call DumpString(s)              '・・・①
    Debug.Print
    Let s = Left$(s, Len(s) - 1)    '1文字切り落とす
    Call DumpString(s)              '・・・②
End Sub

'メモリダンププロシージャ。参考：mima_ita氏 - 実験ぶろぐ（仮）試供品 https://needtec.exblog.jp/20613099/
Private Sub DumpString(ByRef str As String)
    Debug.Print "スタックのダンプ(" & Hex$(VarPtr(str)) & "):"
    Call DumpMemory(VarPtr(str), 4)
    Debug.Print
    Debug.Print "ヒープのダンプ(" & Hex$(StrPtr(str)) & "):"
    Call DumpMemory(StrPtr(str), LenB(str))
End Sub

Private Sub DumpMemory(ByVal memOffset As Long, ByVal memSize As Long)
    Dim memData() As Byte
    Dim memHex As String * 2
    Dim memAddr As String * 8
    Dim dmpStr$
    Dim i&, col_i&
    
    ReDim memData(1 To memSize) As Byte
    Call RtlMoveMemory(VarPtr(memData(1)), memOffset, memSize)
    Let memAddr = Hex$(memOffset)
    Let dmpStr = " " & memAddr & " "
    For i = 1 To memSize
        If col_i = 8 Then
            Let col_i = 0
            Let memAddr = Hex$((memOffset Xor &H80000000) + (i - 1) Xor &H80000000)
            Let dmpStr = dmpStr & vbCrLf & " " & memAddr & " "
        End If
        Let memHex = String$(2 - Len(Hex$(memData(i))), "0") & Hex$(memData(i))
        Let dmpStr = dmpStr & memHex & " "
        Let col_i = col_i + 1
    Next i
    Debug.Print dmpStr
End Sub

実験2の結果：8バイトずつ
①
スタックのダンプ(CFE890):         →変数のアドレス（スタック領域 0xCFE890）
 CFE890   04 40 D5 11             →中身（アドレス11D54004が格納されている）

ヒープのダンプ(11D54004):         →ヒープ領域のアドレス(0x11D54004)
 11D54004 07 30 00 4E 8C 4E 09 4E →〇一二三（Unicode文字列）
 11D5400C DB 56 94 4E 6D 51 03 4E →四五六七
 11D54014 6B 51 5D 4E 41 53       →八九十

②（末尾の文字列を1文字切り取った）
スタックのダンプ(CFE890):         →スタック領域のアドレスは①と同じ(0xCFE890)
 CFE890   EC 3E D5 11             →中身（ヒープ領域のアドレス）は変わっている

ヒープのダンプ(11D53EEC):         →ヒープ領域のアドレス(0x11D53EEC)
 11D53EEC 07 30 00 4E 8C 4E 09 4E →〇一二三（Unicode文字列）
 11D53EF4 DB 56 94 4E 6D 51 03 4E →四五六七
 11D53EFC 6B 51 5D 4E             →八九（十は切り取ったため含まれていない）

実験2を図示してみる。上段（青）の左の列が最初に代入された文字列（①）、右の列がLeft$関数で末尾の一文字を切り落とした文字列（②）が格納されたヒープ領域を表している。赤字で示した箇所は、メモリに格納されているデータが変更された、あるいは新規にデータが追加された箇所である。

つまるところ文字列型は参照型である。そして図の右の列を見ればわかるとおり、代入命令が実行されると、すべての文字列実体を新たなヒープ領域に格納し、スタック領域では文字列実体の参照先を新たに確保したアドレスへ変更する。ヒープ領域の元の文字列実体のデータは、どこからも参照されなくなった時点で自動的に破棄される。関数や結合演算子等の使用の有無は関係なく、代入（Letステートメント）であれば必ずこうなる。

補足：一般的には'Let'を付けず代入のコードを書く人が多いが、それらは'Let'を省略したLetステートメントなので、'Let'を付けようが付けまいが代入である限り動作に変わりはない。

コード上は一文字だけの追加／削除の操作のつもりでも、実際にはすべての文字列を代入し直すのがLetステートメント（代入）である。数値型であろうがブール型であろうがこれは同じだが、それらと違い文字列は格納すべきデータ量が大きく、ヒープ領域にもスタック領域にもデータを格納する必要がある。当然、処理コストは高い。

補足：Microsoftのデータ型の説明では、String型のサイズは10バイト＋文字列の長さ、とある。正確には「スタック領域：4バイト（ヒープ領域の参照先）＋ヒープ領域：先頭4バイト（バイト単位の文字列長）＋文字列リテラル＋末尾2バイト（Null終端文字列）」。範囲の「約20億」は文字数（基本的に1文字＝2バイト）。

そして、&演算子による結合処理も決して軽いとはいえない。どんどん文字を連結していくような処理は、重たい&演算とヒープ領域への文字列の再格納という二つの処理を繰り返し実行するということであり、付け加えれば文字列が長くなるほど領域の確保が大変になっていく、という問題も（たぶん）ある。

ここで登場するのがMidステートメントだが、これは変数に格納された文字列の一部を変更するステートメントで、内部的にはヒープ領域に格納された文字列をそのままに、文字列の一部または全部を変更する。また実験してみよう。

Sub AddressCheckTest2()
    Dim s$
    Let s = "〇一二三四五六七八九十"
    Call DumpString(s)              '・・・①
    Debug.Print
    Mid(s, 6) = "P"
    Call DumpString(s)              '・・・②
End Sub

結果：
①
スタックのダンプ(CFE890):         →スタック領域 0xCFE890
 CFE890   D4 F0 9B 1C             →中身（ヒープ領域のアドレス 0x1C9BF0D4）

ヒープのダンプ(1C9BF0D4):         →ヒープ領域 0x1C9BF0D4
 1C9BF0D4 07 30 00 4E 8C 4E 09 4E →〇一二三
 1C9BF0DC DB 56 94 4E 6D 51 03 4E →四五六七
 1C9BF0E4 6B 51 5D 4E 41 53       →八九十

②（'五'を'P'に置換した）
スタックのダンプ(CFE890):         →スタック領域のアドレスは①と同じ(0xCFE890)
 CFE890   D4 F0 9B 1C             →中身（ヒープ領域のアドレス）も元のまま

ヒープのダンプ(1C9BF0D4):         →ヒープ領域のアドレス(0x1C9BF0D4)
 1C9BF0D4 07 30 00 4E 8C 4E 09 4E →〇一二三（Unicode文字列）
 1C9BF0DC DB 56 50 00 6D 51 03 4E →四P六七　'94 4E'='五'が、'50 00'='P'になっている
 1C9BF0E4 6B 51 5D 4E 41 53       →八九十

先ほどの代入（Letステートメント）と異なり、ヒープ領域の一部の文字列のみを上書きしている。

なお、メモリ領域ではUnicode(UTF-16)で実体が格納されており、半角／全角に関係なく1文字＝2バイトとして扱うので、上記のように全角文字を半角文字に置き換えることも、その逆もできる（バイト単位で指定できるMidBステートメントも一応ある）。

ただし、元の文字列長を超えることはできない。

Sub MidTest()
    Dim str$
    Let str = "TEST"
    Mid(str, 3) = "MPEST"
    Debug.Print str     '結果は「TEMP」
    Mid(str, 5) = "EST" '実行時エラー！
End Sub

4行目は「TEST」の3文字目以降を別の文字列「MPEST」に置き換えるコードだが、元の文字列が4文字なので「MPEST」のうち先頭の2文字（MP）しか使えず、はみ出た文字（EST）は使われることなく捨てられてしまう。このステートメントができるのはあくまで「文字の置換」だけであり、文字列長を変えることはできない。先に書いたとおり半角文字も1文字＝2バイト扱いなので、MidBステートメントでも全角6文字は半角12文字でなく半角6文字にしかなれない。また、当然だが元の文字列が4文字しかないのにMidステートメントで開始位置を5以降にすると実行時エラーとなる。

これらの点にさえ注意すれば、&演算による結合と同じことをMidステートメントで実現できる。あらかじめ結合後の文字列の長さと同じだけの長さを持つ適当な文字列を変数に格納しておき、Midステートメントで文字列を隙間なく置き換えていけばいい。

'※あらかじめ配列strArrに文字列が格納されているものとする。

'&演算による結合
For i = LBound(strArr) To UBound(strArr)
    Let ret = ret & strArr(i)   '文字列を結合
Next i

'Midステートメントによる結合
Let min = LBound(strArr)
Let max = UBound(strArr)
ReDim lenArr(min To max) As Long
For i = min To max                  'すべての文字列長を調べる
    Let lenArr(i) = Len(strArr(i))  '文字列を隙間なく配置するために必要
    Let tLen = tLen + lenArr(i)     'すべての文字列が収まる長さを計算
Next i
Let ret = String$(tLen, vbNullChar) 'ヒープ領域を確保
Let p = 1
For i = min To max
    Mid(ret, p) = strArr(i)         '文字列を結合(置換)
    Let p = p + lenArr(i)           '次の文字列を結合(置換)する位置
Next i

見てのとおりコードはだいぶ膨らんでしまうが、メリットはある。

Sub JoinJoinTest()
    
    Const x As Long = 200               '結合する文字列（要素）数。200～6400の間で検証。
    Const LOOP_COUNT As Long = 10000    '処理が一瞬で終わってしまうので1万倍する
    Dim strArr(1 To x) As String
    Dim lenArr() As Long
    Dim buf As String
    Dim max&, min&, i&, j&, tLen&, p&
    Dim pTime As Single
    
    Let min = LBound(strArr)
    Let max = UBound(strArr)
    For i = min To max
        Let strArr(i) = RandomString()  'ランダムな文字列を生成（コード省略）
    Next i
    
    '&演算子
    Let pTime = Timer
    For i = 1 To LOOP_COUNT
        For j = min To max
            Let buf = buf & strArr(j)
        Next j
        Let buf = ""    '終了処理
    Next i
    Debug.Print Timer - pTime
    
    'Midステートメント
    Let pTime = Timer
    For i = 1 To LOOP_COUNT
        ReDim lenArr(min To max)
        For j = min To max
            Let lenArr(j) = Len(strArr(j))
            Let tLen = tLen + lenArr(j)
        Next j
        Let buf = String$(tLen, vbNullChar)
        Let p = 1
        For j = min To max
            Mid(buf, p) = strArr(j)
            Let p = p + lenArr(j)
        Next j
        Let buf = ""    '終了処理
        Let tLen = 0
    Next i
    Debug.Print Timer - pTime
End Sub

'はみ出そうな場合だけ文字列を再確保するコードの例
Const STR_LEN As Long = 24  '適当にはみ出ないと思われる文字数を指定
Let bufLen = STR_LEN
Let buf = String$(bufLen, vbNullChar)
For j = min To max
    Let strLen = Len(strArr(j))
    If p + strLen > bufLen Then
        'はみ出そうになったら、元の文字列長×2＋結合文字列長の長さにする
        Let bufLen = bufLen * 2 + strLen
        Let buf = buf & String$(bufLen + strLen, vbNullChar)
    End If
    Mid(buf, p + 1) = strArr(j)
    Let p = p + strLen
Next j
If p < bufLen Then
    Let buf = Left$(buf, p) '余分な領域があればトリミングする
End If

Mid(buf, p) = ShapeString(strArr(j)) '文字列を加工する何かしらの関数

Mid(buf, p) = ShapeString(strArr(j))
Let p = InStr(buf, vbNullChar)

Let buf = String$(ABSOLUTE_LIMIT, vbNullChar)    'オーバーフローは発生しない前提の例
Let p = 1
For j = min To max
    Mid(buf, p) = ShapeString(strArr(j))
    Let p = p + InStr(buf, vbNullChar, p)        '\0の出現位置＝次の文字列の結合位置
Next j
Let buf = Left$(buf, p)

Function ShapeString(ByVal src As String) As String
    If Len(src) > 0 Then
        '～文字列を加工する処理～
        Let ShapeString = src
    End If
End Sub

Let buf = String$(ABSOLUTE_LIMIT, vbNullChar)    'オーバーフローは発生しない前提の例
For j = min To max
    Call ShapeString(strArr(j), buf, p)
Next j
Let buf = Left$(buf, p)

Sub ShapeString(ByVal src As String, ByRef dst As String, ByRef cnt As Long)
    If Len(src) > 0 Then
        '～文字列を加工する処理～
        Mid(dst, cnt + 1) = src
        Let cnt = cnt + Len(src)
    End If
End Sub

'０埋め速度比較
    Let src = "12345"       '変換元文字列
    Let sze = 10            '0埋め桁数
    
    'テスト① ・・・Format$関数
    Let dst = Format$(src, String$(sze, "0"))
    
    'テスト② ・・・結合（&演算子）
    Let dst = String$(sze - Len(src), "0") & src
    
    'テスト③ ・・・結合（Midステートメント）
    Let dst = String$(sze, "0")
    Mid(dst, sze - Len(src) + 1) = src
    
    
'カンマ区切り速度比較
    Let src = "1234567890"  '変換元文字列
    
    'テスト① ・・・Format$関数
    Let dst = Format$(src, "#,###")
    
    'カンマ区切テスト② ・・・分解→結合（&演算子）
    Let sze = Len(src)
    Let ptr = sze - Int((sze - 1) / 3) * 3      '先頭の3組（3文字と限らない）の文字数
    Let dst = Left$(src, ptr)                   '先頭の3組（3文字と限らない）を格納
    For i = ptr + 1 To sze - 2 Step 3
        Let dst = dst & "," & Mid$(src, i, 3)   'カンマ＋3組を順次結合
    Next i
    
    'カンマ区切テスト③ ・・・分解→結合（Midステートメント）
    Let sze = Len(src)
    Let com = Int((sze - 1) / 3)                '挿入するカンマの数
    Let dst = String$(sze + com, vbNullChar)    '「元の文字列長＋カンマの数」分の空文字列
    Let ptr = sze - com * 3                     '先頭の3組（3文字と限らない）の文字数
    Mid(dst, 1) = Left$(src, ptr)               '先頭の3組（3文字と限らない）を配置（置換）
    Let ptr = ptr + 1                           '次の結合（置換）位置
    For i = ptr To sze - 2 Step 3
        Mid(dst, ptr) = ","                     'カンマ＋3組を順次結合（置換）
        Mid(dst, ptr + 1) = Mid$(src, i, 3)
        Let ptr = ptr + 4
    Next i

2019-10-18 一部修正

画像を追加。併せて字句をちょこちょこと修正したりリンクを追加したり。

2019-10-29 一部修正

字句の修正、追記など。

2019-10-31 追記・一部修正

おまけを追記。目次を修正。

2019-11-19 修正

イメージ図に若干誤りがあったため画像を差し替え。

＜2019-12-18 修正あり＞

洋々亭にて、様々なVBAコードが公開されている。（2回目）

前回に引き続き、漢数字を半角英数字に変換する関数（conv2num・subconv2num）を、拡張できるようにしつつパフォーマンス改善を試みた。「一億二千三百四十五万六千七百八十九」を「123456789」とか「123,456,789」とか「1億2345万6789」とかに変換する関数。

Option Explicit

Private Const KAN_NUM As String = "一二三四五六七八九"
Private Const KAN_DEC As String = "十百千"              '十進
Private Const KAN_MYR As String = "万億兆京垓"          '万進
Private Const KAN_COM As String = "、，"                '漢数字の桁区切り

'---------------------------------------------------------------------------------------------------
' 漢数字変換関数
' ◆機能の説明
' 　・漢数字（文字列型）を半角英数字の文字列に変換して返す。
' オプション
'   insertsMyriad      ：Trueにすると変換結果に万進(漢字)を挿入する（例：13000→1万3000）
'                        insertsComma（カンマ挿入）と併用可（例：13000→1万3,000）
'   insertsComma       ：Trueにすると変換結果にカンマを挿入する（例：13000→13,000）
' 注意：渡す文字列に漢数字以外の文字を含めないこと（旧字体等も不可）
'       ※漢数字以外の文字が含まれていた場合はすべて「0」に変換されるため正常な結果が返せない
' オリジナル：洋々亭 2010（conv2num関数）
'---------------------------------------------------------------------------------------------------
Private Function KanjiToNum(ByVal srcKanji As String, _
                            Optional ByRef insertsMyriad As Boolean = False, _
                            Optional ByRef insertsComma As Boolean = False) As String
    
    Dim queAsc As String    'キュー（半角英数に変換した文字列）
    Dim bufAsc As String    'バッファ
    Dim tmpAsc As String    '一時変数（切り取りや変換を行った文字列）
    Dim tmpNum As Long      '一時変数（文字列を数値化したものや文字数など）
    Dim strLen As Long      '変換・整形元の文字列長
    Dim bufLen As Long      'バッファサイズ（文字列長）
    Dim maxMyr As Long      '定数で定義されている万進（万・億・兆…）の桁数
    Dim cnvFrom As Long     '変換・整形範囲(From)
    Dim cnvTo As Long       '変換・整形範囲(To)
    Dim ptr As Long         '変換後の文字列型変数内のポインタ
    Dim i As Long           'イテレータ
    
    Let strLen = Len(srcKanji)
    If strLen = 0 Then
        Exit Function
    End If
    
    '前処理
    If srcKanji Like "*[" & KAN_COM & "]*" Then
        For i = 1 To Len(KAN_COM)
            Let srcKanji = Replace(srcKanji, Mid$(KAN_COM, i, 1), "")
        Next i
        Let strLen = Len(srcKanji)
    End If
    Let maxMyr = Len(KAN_MYR)
    Let bufLen = maxMyr * 7     'バッファサイズ=定数の万進数×7（必要に応じ見直すこと）
    If bufLen < strLen Then
        Let bufLen = strLen     '引数の文字数の方が多ければそれをバッファサイズとする
    End If
    Let bufAsc = String$(bufLen, vbNullChar)
    
    '漢数字変換フェーズ
    If srcKanji Like "*[" & KAN_MYR & "]*" Then '万進（万・億・兆・京…）を含む漢数字の変換
        For i = maxMyr To 1 Step -1
            If srcKanji Like "*" & Mid$(KAN_MYR, i, 1) & "*" Then
                Let cnvFrom = cnvTo + 1
                Let cnvTo = CLng(InStr(cnvFrom, srcKanji, Mid$(KAN_MYR, i, 1)))
                If cnvFrom = 1 Then             '初回処理
                    Call KanToNum(Mid$(srcKanji, cnvFrom, cnvTo - cnvFrom), bufAsc, ptr)
                Else                            '2回目以降の処理（4桁固定、0埋め）
                    Call KanToNum(Mid$(srcKanji, cnvFrom, cnvTo - cnvFrom), bufAsc, ptr, 4)
                End If
            ElseIf cnvFrom > 0 Then
                Mid(bufAsc, ptr) = "0000"       '万進がなくとも変換済みの数字があれば万倍する
                Let ptr = ptr + 4
            End If
        Next i
        If cnvTo < strLen Then                  '未処理の漢数字（1万未満）を変換（4桁が前提）
            Call KanToNum(Mid$(srcKanji, cnvTo + 1), bufAsc, ptr, 4)
        Else
            Mid(bufAsc, ptr) = "0000"           'すべて変換済みでも変換結果を万倍する
            Let ptr = ptr + 4
        End If
    Else
        Call KanToNum(srcKanji, bufAsc, ptr)    '単純変換（万進が使われていない場合）
    End If
    Let queAsc = Left$(bufAsc, ptr)             'トリミングして完成
    Let strLen = Len(queAsc)
    
    '英数字整形フェーズ
    If insertsMyriad And (strLen > 4) Then      '万・億・兆…を含む英数字への整形
        Let ptr = 0
        Let cnvTo = 0
        For i = maxMyr To 0 Step -1
            If strLen > (4 * i) Then
                Let cnvFrom = cnvTo + 1
                Let cnvTo = strLen - 4 * i
                Let tmpNum = CLng(Mid$(queAsc, cnvFrom, cnvTo - cnvFrom + 1))
                If tmpNum > 0 Then
                    Let tmpAsc = CStr(tmpNum)   '文字列を数値化→文字列化し、0をトリミング
                    If insertsComma And (tmpNum >= 1000) Then   'カンマ区切り化（再結合）
                        Mid(bufAsc, ptr + 1) = Left$(tmpAsc, 1)
                        Mid(bufAsc, ptr + 2) = ","
                        Mid(bufAsc, ptr + 3) = Mid$(tmpAsc, 2)
                        Let ptr = ptr + 6
                    Else
                        Mid(bufAsc, ptr + 1) = tmpAsc   'カンマ区切りをしない場合は単純結合
                        Let ptr = ptr + Len(tmpAsc) + 1
                    End If
                    If i > 0 Then
                        Mid(bufAsc, ptr) = Mid$(KAN_MYR, i, 1)  '万・億・兆…を末尾に結合
                    Else
                        Let ptr = ptr - 1
                    End If
                End If
            End If
        Next i
        Let KanjiToNum = Left$(bufAsc, ptr)
    ElseIf insertsComma And (strLen > 3) Then   'カンマ区切りを含めた整形
        Let tmpNum = Int((strLen - 1) / 3)      '挿入するカンマの数
        Let KanjiToNum = String$(strLen + tmpNum, vbNullChar)
        Let cnvTo = strLen - tmpNum * 3
        Mid(KanjiToNum, 1) = Left$(queAsc, cnvTo)
        Let ptr = cnvTo + 1
        For i = ptr To strLen - 2 Step 3
            Mid(KanjiToNum, ptr) = ","
            Mid(KanjiToNum, ptr + 1) = Mid$(queAsc, i, 3)
            Let ptr = ptr + 4
        Next i
    Else
        Let KanjiToNum = queAsc                 '単純コピー（整形しない場合）
    End If
End Function

'---------------------------------------------------------------------------------------------------
' 漢数字（十進まで）変換プロシージャ
' ◆機能の説明
' 　・漢数字を半角英数字に変換し、dstVarに指定した変数に追記（上書き）する
' 引数
'   srcKanji：変換元となる漢数字（Source Kanji)
'             ※〇～九・十・百・千の漢数字のみ。万・億・兆…などは受け付けないので注意
'   dstVar  ：変換結果（半角英数字）を格納する文字列型変数(Destination Variable)
'             ※必ず、変換結果を格納できるだけの文字列長を持つ可変長文字列型変数を指定すること
'   posVar  ：dstVarに文字列が既にある場合の、文字列の終端位置を格納した長整数型変数(End Position)
'             ※例：3文字目以降に上書きしたい場合は「2」が格納された長整数型変数を指定
' 　          ※変数を指定せず数値を直接指定してもいい。その場合、変数posVarの上書きは行われない
'             ※変換後の文字列を最後にトリミングする必要があるような場合は、変数を指定すること
'   fixLen  ：固定したい桁数(Fix Length)
'             ※1以上の数値を指定した場合、その桁数分の範囲内で0埋めを行う（切り詰めは行わない）
'               例：srcKanjiが「二十四」でfixLenが「4」の場合、変換結果は「0024」
' 前提：渡された文字列には、「〇～九・十・百・千」の漢数字しか含まれていない（万進・旧字体等も不可）
'       ※上記数字以外の文字が含まれていた場合はすべて「0」に変換されるため正常な結果が返せない
' オリジナル：洋々亭 2010（subconv2num関数）
'---------------------------------------------------------------------------------------------------
Private Sub KanToNum(ByRef srcKanji As String, _
                     ByRef dstVar As String, _
                     Optional ByRef posVar As Long = 0, _
                     Optional ByRef fixLen As Long = 0)
    
    Dim srcLen As Long  '変換元（漢数字）の文字列長
    Dim cnvFrom As Long '変換範囲のポインタ(From)
    Dim cnvTo As Long   '変換範囲のポインタ(To)
    Dim szLen As Long   'ゼロ埋めの長さ
    Dim i&, j&          'イテレータ（&はLong型の型宣言文字）
    
    Let srcLen = Len(srcKanji)
    If srcKanji Like "*[" & KAN_DEC & "]*" Then     '十進（十・百・千）の字を含む漢数字の変換
        For i = Len(KAN_DEC) To 1 Step -1           '千の位～十の位まで処理（一の位は処理しない）
            If srcKanji Like "*" & Mid$(KAN_DEC, i, 1) & "*" Then
                Let cnvFrom = cnvTo + 1
                Let cnvTo = CLng(InStr(cnvFrom, srcKanji, Mid$(KAN_DEC, i, 1)))
                If cnvFrom = 1 Then
                    If (fixLen - 1) > i Then
                        Let szLen = fixLen - i - 1
                        Mid(dstVar, posVar + 1) = String$(szLen, "0")
                        Let posVar = posVar + szLen
                    End If
                End If
                If cnvFrom < cnvTo Then             '十進の左の漢数字を抽出・変換（例：四五千→45）
                    For j = cnvFrom To cnvTo - 1    'InStr探索（一～九→1～9 それ以外→KAN_NUMにないので0）
                        Let posVar = posVar + 1
                        Mid(dstVar, posVar) = CStr(InStr(KAN_NUM, Mid$(srcKanji, j, 1)))
                    Next j
                Else
                    Let posVar = posVar + 1
                    Mid(dstVar, posVar) = "1"       '十進の左に漢数字がない場合は1（例：千→1）
                End If
            ElseIf cnvFrom > 0 Then
                Let posVar = posVar + 1
                Mid(dstVar, posVar) = "0"           '十進がなくとも変換済みの数字があれば10倍する
            End If
        Next i
    Else
        If srcLen < fixLen Then
            Let szLen = fixLen - srcLen
            Mid(dstVar, posVar + 1) = String$(szLen, "0")
            Let posVar = posVar + szLen
        End If
    End If
    If cnvTo < srcLen Then                          '未処理の漢数字を変換
        For i = cnvTo + 1 To srcLen                 '（十進を含む文字列の一の位 or 十進を含まない文字列の全部）
            Let posVar = posVar + 1
            Mid(dstVar, posVar) = CStr(InStr(KAN_NUM, Mid$(srcKanji, i, 1)))
        Next i
    ElseIf cnvFrom > 0 Then
        Let posVar = posVar + 1
        Mid(dstVar, posVar) = "0"                   'すべて処理済みでも変換済みの数字があれば10倍する
    End If
End Sub

大きく異なる点は、プロシージャ内の定数や定数的に使用されている文字列を、複数の関数やプロシージャで使用することを想定してモジュールレベル定数にしたことや、カンマや読点で区切られている漢数字（たまにある）を一連の数値とみなす処理を挟んだこと。

ただし後者は、カンマや読点で区切られた複数の数値との見分けが困難な（例えば『一二三、四五六』が123と456なのか12万3,456なのか）シチュエーションが考えられるので、基本的には関数に漢数字を渡す前にふるい分けすることを期待している。

中身はかなり弄ったが、大きくはRegExpオブジェクトの使用をやめたり、京・兆・億・万で分かれていた処理をまとめたり。一番悩んだのが「なるべくコストのかからない処理方法」の模索。

元のconv2num関数による数字変換のプロセスは、万・億・兆・京で文字列を分割し、それぞれにsubconv2関数で英数字に変換。それらを結合して、引数numform・setcomにより変換後の文字列を整形、となっている（引数に万・億・兆・京が含まれている場合）。

KanjiToNum関数も、基本的なコンセプトはconv2num・subconv2numのそれをそのまま引き継いだ。ただ違うのは、conv2num関数では万・億・兆・京それぞれで変数を持っていたが、KanjiToNum関数ではすべて一つの変数に連結することにした。

つまり、例えば「三千五百億」は一度「350000000000」に直してから「350,000,000,000」なり「3500億」なり「3,500億」なりに整形する。この辺あまり効率が良くないとは思ったが、最大公約数的に考えて確実さを優先した。

で、その分、文字列操作処理をなるべく軽くすることにチャレンジした。それがMidステートメントを利用する方法。Mid関数ではない。Midステートメントはステートメントなので、基本的には行頭に書かれていなければならないし、Mid関数は関数なので基本的には式の右辺にあるべきもの。

可能な限り文字列型変数への代入を減らすことでパフォーマンスを改善できないかという試み。

もっと極端なことをやれば、関数内でいちいち結合している定数的な文字列（'"*[" & KAN_MYR & "]*"'とか）を全部モジュールレベルで変数なり定数化してしまえばパフォーマンス向上は見込めるが、モジュールの宣言部があまりにもゴチャゴチャしすぎるのでやってない。あとクラス化やプロシージャ化も考えたが、コストが高くなったりメリットを潰してしまったりしたのでそれもやってない。

あと一応、垓より上の数にも対応できるようにはしている。が、一文字の数に限る。恒河沙とか阿僧祇とか不可思議とか無量大数とかには対応できない。それからVBEの仕様上、垓の上の'𥝱'をそのまま使えない（Shift_JISにない）のでひと工夫必要だと思う。

2019-09-19 一部修正

古いコードを貼り付けてしまっていたので新しいコードに差し替えた（一部ちょっと変わった）。あと、'ジョ'の漢字がバグったのでカタカナ表記に修正。

2019-09-22 一部修正

最終バージョンに更新・・・（たぶん）これが一番新しかったと思います。

2019-10-08 一部修正

色々と修正。後日記事を書くかも。

2019-10-11

Midステートメントについての記事を作成。

2019-12-18

カタカナで表記していた「𥝱」を数値文字参照に置き換え。

＜2019-09-14 追記あり＞

以前書いた3値の中央値をIfを使わずに求める方法で、少なくとも自分の環境のVBAではIfを使った方が速いと書いた。

が、原因がよくわからずモヤっとしていた。

試しにC++で同じように比較してみたところ、C++ではIfあり・なしで処理時間にそう大きな差はなかった。この違いは何なんだろうか？

試しにオンラインでアセンブリを確認できるサイトで、C++で書いたコードをアセンブリ言語にしてみた（Visual Studioのコンパイルのオプションでアセンブリを出力することもできたが、こちらのサイトでやった方がコードが見やすかった）。

int med(int a, int b, int c) {
    return a ^ b ^ c ^ (-(a < b) & (a ^ b)) ^ (-(b < c) & (b ^ c)) ^ (-(c < a) & (c ^ a));
}

↓

        mov     edx, DWORD PTR _a$[esp-4]
        mov     eax, edx
        mov     ecx, DWORD PTR _c$[esp-4]
        push    esi
        mov     esi, DWORD PTR _b$[esp]
        xor     eax, esi
        push    edi
        xor     edi, edi
        cmp     edx, esi
        cmovl   edi, eax
        cmp     ecx, edx
        cmovl   edx, ecx
        xor     edi, edx
        cmp     esi, ecx
        cmovl   esi, ecx
        xor     edi, esi
        xor     edi, ecx
        mov     eax, edi
        pop     edi
        pop     esi
        ret     0

上記のコードは最適化を有効にしている(/O1)。アセンブリはあまり詳しくないが、'-(a < b) & (a ^ b)'的な部分の処理が以下のような感じで非常にシンプルになっている。

        mov     edx, DWORD PTR _a$[esp-4]
        mov     eax, edx
        mov     esi, DWORD PTR _b$[esp]
        xor     eax, esi
        cmp     edx, esi
        cmovl   edi, eax

先にa^bを計算してeaxレジスタに保存しておき（4行目）、a<bを評価し（5行目）真なら値をコピーする（6行目）。最適化を行わないと、以下のようになってしまう。

        mov     eax, DWORD PTR _a$[ebp]
        cmp     eax, DWORD PTR _b$[ebp]
        jge     SHORT $LN3@med
        mov     DWORD PTR tv68[ebp], 1
        jmp     SHORT $LN4@med
$LN3@med:
        mov     DWORD PTR tv68[ebp], 0
$LN4@med:
        mov     ecx, DWORD PTR _a$[ebp]
        xor     ecx, DWORD PTR _b$[ebp]
        mov     edx, DWORD PTR tv68[ebp]
        neg     edx
        and     ecx, edx

aとbを比較し（2行目）、a<bなら1（4行目）、a>=bなら0（7行目まで）を一旦格納してから符号を反転し（12行目）、a^b（10行目）の結果をand演算（13行目）している。&は論理積(and)のビット演算子だし-は符号を反転するので、これが本来的な動作ではある。

が、大小を比較して(cmp命令)フラグレジスタを見て1か0を格納し(jge命令・mov命令・jmp命令)符号反転(neg命令)したものをビット演算(and命令)する代わりに、大小を比較して(cmp命令)フラグレジスタを見て値をコピーするか何もしない(cmovl命令)ようにしても同じ結果が得られるし、この方がすっきりするしずっと速い。

まぁ、C++の方はこうなってた。最適化スゴイ。cmovlスゴイ。

さてVBだ。VBはオンラインでこう、中身・・・中間言語・・・MSIL、を見る、とかいうのがないので、Visual Studioに附属しているIL Dasmを使った。

Function Med(ByRef a As Long, ByRef b As Long, ByRef c As Long) As Long
    Return a Xor b Xor c Xor ((a < b) And (a Xor b)) Xor ((b < c) And (b Xor c)) Xor ((c < a) And (c Xor a))
End Function

↓

  IL_0000:  ldarg.0
  IL_0001:  ldind.i8
  IL_0002:  ldarg.1
  IL_0003:  ldind.i8
  IL_0004:  xor
  IL_0005:  ldarg.2
  IL_0006:  ldind.i8
  IL_0007:  xor
  IL_0008:  ldarg.0
  IL_0009:  ldind.i8
  IL_000a:  ldarg.1
  IL_000b:  ldind.i8
  IL_000c:  clt
  IL_000e:  ldc.i4.0
  IL_000f:  cgt.un
  IL_0011:  neg
  IL_0012:  conv.i8
  IL_0013:  ldarg.0
  IL_0014:  ldind.i8
  IL_0015:  ldarg.1
  IL_0016:  ldind.i8
  IL_0017:  xor
  IL_0018:  and
  IL_0019:  xor
  IL_001a:  ldarg.1
  IL_001b:  ldind.i8
  IL_001c:  ldarg.2
  IL_001d:  ldind.i8
  IL_001e:  clt
  IL_0020:  ldc.i4.0
  IL_0021:  cgt.un
  IL_0023:  neg
  IL_0024:  conv.i8
  IL_0025:  ldarg.1
  IL_0026:  ldind.i8
  IL_0027:  ldarg.2
  IL_0028:  ldind.i8
  IL_0029:  xor
  IL_002a:  and
  IL_002b:  xor
  IL_002c:  ldarg.2
  IL_002d:  ldind.i8
  IL_002e:  ldarg.0
  IL_002f:  ldind.i8
  IL_0030:  clt
  IL_0032:  ldc.i4.0
  IL_0033:  cgt.un
  IL_0035:  neg
  IL_0036:  conv.i8
  IL_0037:  ldarg.2
  IL_0038:  ldind.i8
  IL_0039:  ldarg.0
  IL_003a:  ldind.i8
  IL_003b:  xor
  IL_003c:  and
  IL_003d:  xor
  IL_003e:  ret

このMSILとかCILとかいうのはさっぱりだったが、ldargで引数のアドレスをスタックにpushして、ldind.i～でスタックに積まれたアドレスをpopして値を取得し、i～に応じてint32やint64の数値に置き換えpushしているらしい。ようは命令がすべてスタック上で行われるスタックマシンというやつらしい。

コードを読み解いていくと、どうもスタックというものは一つしかないらしく、絶えずldarg・ldindで引数をスタックに積み込んでは命令を実行してpopされ、またldarg・ldindでスタックに積み・・・ということを繰り返しているように思える。

jmpのような飛ぶ系の命令は使われていないようだが、スタック上を線形に（というのだろうか）行ったり来たりしているように見える。

8行目(IL_0007)まではa Xor b Xor cを実行していて、9行目から24行目(IL_0019)までが'Xor ((a < b) And (a Xor b))'の処理。以降、16行ずつbとc、cとaの処理。

何をしているのかというと、ようは2つの値をスタックにpushして(ldarg.0～2・ldind.i8)大小を比較して1か0をpushして(clt)、なぜか比較結果と0(ldc.i4.0)を比較して1か0をpushして(cgt.un)、符号を反転して(neg)int64に変換して(conv.i8)、もう一度2つの値をスタックにpushして(ldarg・ldind.i8)、2つの値をxorした値を0か-1とandして、その値とあらかじめスタックしていた a Xor b Xor c の値をxorしている。

これをあと2回繰り返している。ようするに最適化していないC++のアセンブリのコードとロジック的にほぼ同じことをやっているようだ。jmp系の命令がない点や比較を2回繰り返している点や、64ビット整数への変換が噛んでいるという違いはあるが。ちなみにLongを全部Integerにしてやってみたが、int64へのコンバートがなくなっただけで処理はほとんど同じだった。

ちなみにIfを使った場合はだいたい以下のような感じになる。

Function Med(ByRef a As Long, ByRef b As Long, ByRef c As Long) As Long
    If a < c Then
        If b < a Then
            Return a
        ElseIf B < c Then
            Return b
        Else
            Return c
        End If
    ElseIf a < b Then
        Return a
    ElseIf c < b Then
        Return b
    Else
        Return c
    End If
End Function

↓

  IL_0000:  ldarg.0
  IL_0001:  ldind.i8
  IL_0002:  ldarg.2
  IL_0003:  ldind.i8
  IL_0004:  bge.s      IL_0021
  IL_0006:  ldarg.1
  IL_0007:  ldind.i8
  IL_0008:  ldarg.0
  IL_0009:  ldind.i8
  IL_000a:  bge.s      IL_0011
  IL_000c:  ldarg.0
  IL_000d:  ldind.i8
  IL_000e:  stloc.0
  IL_000f:  br.s       IL_003a
  IL_0011:  ldarg.1
  IL_0012:  ldind.i8
  IL_0013:  ldarg.2
  IL_0014:  ldind.i8
  IL_0015:  bge.s      IL_001c
  IL_0017:  ldarg.1
  IL_0018:  ldind.i8
  IL_0019:  stloc.0
  IL_001a:  br.s       IL_003a
  IL_001c:  ldarg.2
  IL_001d:  ldind.i8
  IL_001e:  stloc.0
  IL_001f:  br.s       IL_003a
  IL_0021:  ldarg.0
  IL_0022:  ldind.i8
  IL_0023:  ldarg.1
  IL_0024:  ldind.i8
  IL_0025:  bge.s      IL_002c
  IL_0027:  ldarg.0
  IL_0028:  ldind.i8
  IL_0029:  stloc.0
  IL_002a:  br.s       IL_003a
  IL_002c:  ldarg.2
  IL_002d:  ldind.i8
  IL_002e:  ldarg.1
  IL_002f:  ldind.i8
  IL_0030:  bge.s      IL_0037
  IL_0032:  ldarg.1
  IL_0033:  ldind.i8
  IL_0034:  stloc.0
  IL_0035:  br.s       IL_003a
  IL_0037:  ldarg.2
  IL_0038:  ldind.i8
  IL_0039:  stloc.0
  IL_003a:  ldloc.0
  IL_003b:  ret

bge.sとかbr.sとかいうのがjmp系の命令。ジャンプはするが、処理命令数は最小16～最大21程度に抑えられる。Ifを使わずに計算している方は57。

これはつまり、演算や比較が生じる毎に何度もpushするような処理は遅くなる、ということだろうか。C++は複数の汎用レジスタに値を置けるが、VBはそれができない、ということだろうか。

なんというかこう、なんでcltとcgt.unで2回比較を繰り返しているのかとか、3つしかない引数を何度も何度もpushしているところはなんとかならないのかとか、見るからに一つのスタックだけでやりくりしているように思えるが本当にそうなのかとか、もうちょっとなんとかならないのかと思うところがある。

が、ひとえに自分のスキル・知識が足りてないのが一番の原因ということに行き着いた。現時点では「VBでは条件分岐の有無より演算や比較の回数をとにかく減らした方が効率がいい」ということかなと整理している。ゆくゆくはこういったアセンブリやILといったものを元にしてコードを最適化できるようになりたい。

2019/09/14 追記

よくよく調べてみたら、コンパイルしてMSIL(CIL)が出力されるのはVB.NETだけであって、「VBAが出力するPコードとやらもMSIL(CIL)なんでしょ？」と思ってたらどうやら違ったらしい。死にたい。割と。

「じゃあVBAが出力するPコードとやらはどんなコードなのよ？」と思い調べてみたが、なぜか知らないがかなり情報が少ない。

かろうじて見つけたP-Code Disassemblerなるツールで、Pコードをダンプできるらしいのでやってみた。

Option Explicit

Function Med(ByRef a As Long, ByRef b As Long, ByRef c As Long) As Long
    Let Med = a Xor b Xor c Xor ((a < b) And (a Xor b)) Xor ((b < c) And (b Xor c)) Xor ((c < a) And (c Xor a))
End Function

↓

Line #0:
        Option  (Explicit)
Line #1:
Line #2:
        FuncDefn (Function Med(ByRef a As Long) As Long)
Line #3:
        Let 
        Ld a 
        Ld B 
        Xor 
        Ld c 
        Xor 
        Ld a 
        Ld B 
        Lt 
        Paren 
        Ld a 
        Ld B 
        Xor 
        Paren 
        And 
        Paren 
        Xor 
        Ld B 
        Ld c 
        Lt 
        Paren 
        Ld B 
        Ld c 
        Xor 
        Paren 
        And 
        Paren 
        Xor 
        Ld c 
        Ld a 
        Lt 
        Paren 
        Ld c 
        Ld a 
        Xor 
        Paren 
        And 
        Paren 
        Xor 
        St Med 
Line #4:
        EndFunc 

このPコードとやらのリファレンスというものがなぜか見つからないので、正直これが正しいのかはわからないが、やっていることはなんとなく想像がつく。LdはLoad、Stは後続の名前の変数へのSet、Letはまんま代入のステートメント、Ltは比較(Less Than)して-1か0をセット、Parenは括弧だから演算の優先順位？・・・うん、ILDasmで見たのとあんま変わらんわこれ。

要はVB.NETにせよVBAにせよ、根本的にはスタックベースで動作している、ということかな・・・っておもいました。

で、そうなるとやはり同じ値を何度も参照するような処理を減らす方がパフォーマンスを改善できる、ということになるか。

とりあえず9つあるParenは3つに減らせるものの、Paren自体は命令の順序を入れ替えてるだけで何のコストも発生していないように思われる（Parenを削っても普通に処理の順序を読み解くことができる→おそらくParen自体は何の命令も発していない）。

研鑽を積もう。

以前、さくらのレンタルサーバの仕様とblosxomの仕様の兼ね合いで若干問題が生じることについて触れた。

が、実は2017年3月に仕様変更があり、MultiViewsオプションが使用できるようになっていた。

以前書いたとおり、blosxomのカテゴリとして使用するディレクトリと同じ名前のファイルを設置すると、カテゴリに遷移した時にファイルの方の中身がぶちまけられてしまう、という問題があったが、

Options -MultiViews

と.htaccessに記述するだけで、ファイル名とディレクトリ名がカブっても問題なく動作するようになる。

以前から直っていたが、記事をそのまま放置してしまっていた。

ただし、環境変数を追加できない問題だけは解決していない。が、これは仕方ないと思うし、むしろコードの方がある程度自由に弄られることを許容してるんじゃないかな？　と考えてたりもする。自分のスキル不足もある。

先日貼ったクイックソートのコードにもちょっとだけ使ってたが、XOR（排他的論理和）を利用して色々と面白いことができる。

有名なのはXOR交換アルゴリズムだが、これは二つの変数に格納されている値を交換するとき、一時変数を介すことなくXORだけで二つの変数の値を交換してしまえるという手法。VBAで記述すると以下のようになる。

A = A Xor B
B = A Xor B 'Aの値が代入される
A = A Xor B 'Bの値が代入される

なぜこうなるのか？　2行目を数式にすると、

(A Xor B) Xor B = A

である。XORは括弧の有無や括弧の位置を変えても計算結果は変わらない（結合法則）。なので、

B Xor B Xor A = A

でも同じである。XORは排他的論理和（2値がどちらも真または偽の場合は偽、それ以外は真）であるので、同じ値をXORすると0になる。よって、

(B Xor B) Xor A = A
0 Xor A = A
A = A

である（Aと0をXORした場合はそのままAが返る）。つまり、 A XOR B の結果（仮にA'とする）をもう一度BとXORすることでAを求めることができ、同様にA'をAとXORすればBが求められる。XORは非常に面白い性質を持っている。

ちなみに、XOR交換は3値以上でも成り立つ。要は複数の値を全てXORした結果に対し、ある一値以外のすべての値をXORしてやれば、その一値が求められる。

A = A Xor B Xor C Xor D Xor E Xor F
B = A Xor B Xor C Xor D Xor E Xor F 'Aの値が代入される（A Xor B Xor C Xor D Xor E Xor F Xor B Xor C Xor D Xor E Xor F と等価）
C = A Xor B Xor C Xor D Xor E Xor F 'Bの値が代入される（A Xor B Xor C Xor D Xor E Xor F Xor A Xor C Xor D Xor E Xor F と等価）
D = A Xor B Xor C Xor D Xor E Xor F 'Cの値が代入される（A Xor B Xor C Xor D Xor E Xor F Xor A Xor B Xor D Xor E Xor F と等価）
E = A Xor B Xor C Xor D Xor E Xor F 'Dの値が代入される（A Xor B Xor C Xor D Xor E Xor F Xor A Xor B Xor C Xor E Xor F と等価）
F = A Xor B Xor C Xor D Xor E Xor F 'Eの値が代入される（A Xor B Xor C Xor D Xor E Xor F Xor A Xor B Xor C Xor D Xor F と等価）
A = A Xor B Xor C Xor D Xor E Xor F 'Fの値が代入される（A Xor B Xor C Xor D Xor E Xor F Xor A Xor B Xor C Xor D Xor E と等価）

で。ふと、XOR交換以外にも色々と応用が利くんじゃないか？　と思った。具体的には条件分岐の代用とか。探したところ、研究員の津田氏のブログ「津田の開発な日記」にて条件分岐を使わずにmax/min関数を実現する方法というものが公開されていた。以下引用。

int max(int a, int b) {
    return a ^ ((a ^ b) & -(a < b));
}

これをVBAで書くとこうなる。

Public Function max(ByRef a As Long, ByRef b As Long) As Long
    Let max = a Xor ((a Xor b) And (a < b))
End Function

このC言語の例では比較演算の真値が1となるため正負反転を行っているが、VBでは真値が-1となる（偽はいずれも0）ので、正負の反転は必要ない。要は、a < b が成立するなら a Xor ((a Xor b) And -1) = b、成立しなければ a Xor ((a Xor b) And 0) = a となり、ちゃんとmax関数としての機能を果たしている。ちなみに-1は全てのビット列が1、つまり0が裏返った値なので、A And -1 = Aとなる。

なおmin関数は、このmax関数のコードの不等号を反転するか、あるいは最初のaをbにするだけでいい。

Public Function min(ByRef a As Long, ByRef b As Long) As Long
    Let min = b Xor ((a Xor b) And (a < b))
End Function

ちなみに先のブログによれば、不等号の部分は条件分岐になっていない（アセンブラコード上では分岐命令を使用していない）、とのこと。ただしあくまでもC言語での話なので、VBでどうなってるかは不明。分岐命令を使っているとしたら動作は遅くなるかもしれない。

まぁ、最初の予想に反してXORだけで条件分岐の代わりをすることは難しいが、他の演算と組み合わせて条件分岐の代わりになる、ということは分かった。

で、これを応用すれば3値の中央値(median)を求めることも可能なんじゃないか？　と思い立った。要は偶数回出現した値は消えて奇数回出現した値は残るんだから、以下の計算で中央値が求められるはずだ。

A Xor B Xor C Xor max(A, B, C) Xor min(A, B, C) = median

A・B・C・最大値・最小値の5つをXORすることで、最大値と最小値はそれぞれ2回（偶数回）、中央値は1回（奇数回）だけ演算することになり、中央値のみが残る。早速やってみる。

Public Function med(ByRef A As Long, ByRef B As Long, ByRef C As Long) As Long
    Dim tmpMax&, tmpMin&
    Let tmpMax = A Xor ((A Xor B) And (A < B))
    Let tmpMin = A Xor ((A Xor B) And (A > B))
    Let med = A Xor B Xor C Xor _
              (C Xor ((C Xor tmpMax) And (C < tmpMax))) Xor _
              (C Xor ((C Xor tmpMin) And (C > tmpMin)))
End Function

できた。

これでもちゃんと動くが、冗長すぎる。もうちょっとスマートにしたい。どうすればいいか考えていたところ、C を2回続けてXORしている部分の外側の方のXor C は、演算の優先順位を下げても演算結果に影響しないことに気付いた（結合法則）。

    Let med = A Xor B Xor C Xor _
              C Xor ((C Xor tmpMax) And (C < tmpMax)) Xor _
              C Xor ((C Xor tmpMin) And (C > tmpMin))

上記のように左端の方のXor C を括弧の外に出しても演算結果は変わらない。すると、同じ優先順位の層で C が何度もXORされていることになる。XORは可換（XOR以外の演算と結合しない箇所であれば位置を交換しても結果が同じ）なので、

    Let med = A Xor B Xor C Xor C Xor C Xor _
              ((C Xor tmpMax) And (C < tmpMax)) Xor _
              ((C Xor tmpMin) And (C > tmpMin))

としても演算結果は同じである。ところで先に述べたとおり、同じ値を奇数回XORすると元の値に戻る。なので Xor C を3回も繰り返す必要はない。1回で十分である。

    Let med = A Xor B Xor C Xor _
              ((C Xor tmpMax) And (C < tmpMax)) Xor _
              ((C Xor tmpMin) And (C > tmpMin))

A・B・C・3値の最大値・3値の最小値をXORするはずだったのに、2行目と3行目の内容が変わってしまった。それでも演算結果は変わらない。どういうことか。

2行目は「C < max(A, B) の場合は (C Xor max(A, B)) を XORする」、3行目は「C > min(A, B) の場合は (C Xor min(A, B)) を XORする」、ということだ。

A < B < C と仮定してみると、2行目は C < B が偽となり0、3行目は C > A が真となり1行目の結果に A Xor C をXORし、最終的に B が返る。

逆に A > B > C と仮定すると、2行目は C < A が真で A Xor C、3行目は C > B が偽となり0。結果はやはりB。

では B < A < C の場合は？　A Xor B Xor C Xor 0 Xor B Xor C で結果はA。B < C < A だと A Xor B Xor C Xor A Xor C Xor B Xor C で結果はC。

この時、なにか閃いた。これはたぶんなんかこういうことだ！　と走り書きしたメモが以下。

'たぶんなんかこういうやつ。
If A < B Then
    'A Xor B
    If B < C Then
        'B Xor C
    ElseIf C < A Then
        'C Xor A
    End If
ElseIf B < C Then
    'B Xor C
    If C < A Then
        'C Xor A
    End If
ElseIf C < A Then
    'C Xor A
End If

'以下に置き換えられるはず。
If A < B Then
    'A Xor B
End If
If B < C Then
    'B Xor C
End If
If C < A Then
    'C Xor A
End If

たぶんなんかこういうやつ。で、できたのが以下のコード。

Public Function med3(ByRef A As Long, ByRef B As Long, ByRef C As Long) As Long
    Let med3 = A Xor B Xor C Xor ((A Xor B) And (A < B)) Xor ((B Xor C) And (B < C)) Xor ((C Xor A) And (C < A))
End Function

何をやっているかというと、A XOR B XOR C の演算結果に対し、A < B のときは A と B、B < C のときは B と C、C < A のときは C と A をそれぞれXORしている。

こうすると3値の中央値を求めるために最大値・最小値を求める必要がないため、計算量も減ったし一時変数も不要になった。ダラダラした条件分岐を使う必要もない。キモチイイ！

ただし、

'Ifを使わずに中央値を求める関数
Public Function med3(ByRef A As Long, ByRef B As Long, ByRef C As Long) As Long
    Let med3 = A Xor B Xor C Xor ((A Xor B) And (A < B)) Xor ((B Xor C) And (B < C)) Xor ((C Xor A) And (C < A))
End Function

'Ifを使って中央値を求める関数
Public Function medIF(ByRef A As Long, ByRef B As Long, ByRef C As Long) As Long
    If A < C Then
        If B < A Then
            Let medIF = A
        ElseIf B < C Then
            Let medIF = B
        Else
            Let medIF = C
        End If
    ElseIf A < B Then
        Let medIF = A
    ElseIf C < B Then
        Let medIF = B
    Else
        Let medIF = C
    End If
End Function

'乱数発生器
Private Function RandomLong(ByRef minVal As Long, ByRef maxVal As Long, Optional ByRef doRandomize As Boolean = True) As Long
    If doRandomize Then
        Randomize
    End If
    Let RandomLong = Int(Rnd * (maxVal - minVal + 1)) + minVal
End Function

'速度検証
Sub SpeedTestMed()
    Dim A As Long
    Dim B As Long
    Dim C As Long
    Dim M As Long
    Dim i As Long
    Dim loopCnt As Long
    Dim pTime As Single
    Let A = RandomLong(1, 200000000)
    Let B = RandomLong(1, 200000000)
    Let C = RandomLong(1, 200000000)
    Let loopCnt = 5000000
    Let pTime = Timer
    For i = 1 To loopCnt
        Let M = medIF(A, B, C)
    Next i
    Debug.Print "medIF:" & Timer - pTime    'medIF:0.4296875
    Let pTime = Timer
    For i = 1 To loopCnt
        Let M = med3(A, B, C)
    Next i
    Debug.Print "med3: " & Timer - pTime    'med3: 0.4453125
End Sub

少なくとも自分の環境のVBAでは、普通にIfで条件分岐した方が速い。

2019/08/26　追記

Public Function med3(ByRef A As Long, ByRef B As Long, ByRef C As Long) As Long
    Let med3 = A Xor B Xor C Xor ((A < B) And (A Xor B)) Xor ((B < C) And (B Xor C)) Xor ((C < A) And (C Xor A))
End Function

以前書いたコードとAndの前後が入れ替わっているが、結果には影響しない。左から読んで「『A < B』なら『A Xor B』」と読めるので、自分はこの順番の方が好き。

なぜこの数式で中央値が求められるのか、少し掘り下げてみる。XORについてはベン図を使うとわかりやすい。A < B < C と仮定し数式を左から順に読み解くと、

A

Xor B

Xor C

Xor ((A < B) And (A Xor B))

の(A < B)は今回の仮定では真(-1)であり、

Xor ((-1) And (A Xor B))
= Xor (A Xor B)
= Xor A Xor B

となるので、Xor A と Xor B に分解してそれぞれ評価してみる。

Xor A

Xor B

次。

Xor ((B < C) And (B Xor C))

これも(B < C)は真(-1)なので、上と同様にXor B と Xor C に分解。

Xor B

Xor C

次。

((C < A) And (C Xor A))

の(C < A)は偽(0)なので、

Xor ((0) And (C Xor A))
= Xor (0)
= Xor 0

0をXORしても値は変わらないので、

がそのまま結果となる。

他のパターンでも同様に求めることができる。

また、3値のうち2値が同値だった場合はその2値の方が返るようになっている。

3値とも同値だった場合は、もちろんその値が中央値となる。

洋々亭にて、様々なVBAコードが公開されている。

この中に含まれている、丸付き数字（「○２」など）を丸囲み数字（「②」など）に変換する関数を、⓪～㊿まで対応できるように改造した。

ちなみになんでこんな関数が必要かというと、一部の法令（児童福祉法など）は、項番号の代わりに丸数字を使用していることがあるが、丸数字は機種依存文字（環境依存文字）なので正しく表示されないコンピュータが存在する恐れがあり、e-Govでは「○２」としている。これを本来意図するところの丸数字に置き換えるため。

現在ではほとんどの機種（環境）で丸数字が表示できるようになっており、これを一括変換したいという要望があったので、洋々亭のコードを拝借し、かつ範囲を広げた。

'---------------------------------------------------------------------------------------------------
' 丸付き数字置換関数
' ◆機能の説明
'   ・「○３」形式の表記を「③」に変換する
'   ・一部文字列はUnicode文字に変換する
'   ・一定数を超える数字の場合は丸囲み数字が使用できないため、角かっこで囲む（○５１→[51]）
'   ※項番号を上記の方法で表記している法令があるための対処（児童福祉法等）。
' オリジナル：洋々亭 2006
'---------------------------------------------------------------------------------------------------
Private Function ToCircledNum(ByRef srcStr As String) As String
    
    Dim srcLen As Long      '引数の文字列長（○を含む）
    Dim tmpAsc As String    '引数から○を除去し半角英数に変換した文字列
    Dim chrNum As Long      '変換後の数字
    Dim i As Long           'イテレータ
    
    'まず全角数字を半角数字に置き換え、次に半角数字を丸数字に置き換える。
    Let srcLen = Len(srcStr)
    If srcLen < 2 Then
        Exit Function
    End If
    Let tmpAsc = String$(srcLen - 1, vbNullChar)
    For i = 2 To srcLen
        Mid(tmpAsc, i - 1, 1) = Mid$("0123456789", CLng(InStr("０１２３４５６７８９", Mid$(srcStr, i, 1))), 1)
    Next i
    Let chrNum = CLng(tmpAsc)
    Select Case chrNum
    Case Is < 0                                 '0未満は非対応([]で括る)
        Let ToCircledNum = "[" & tmpAsc & "]"
    Case 0                                      '丸0  = U+24EA( 9450) chrNum=0のためそのまま
        Let ToCircledNum = ChrW(9450)
    Case Is < 21                                '1～20は普通に丸囲み数字が使用できる
        Let ToCircledNum = Mid$("①②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑳", chrNum, 1)
    Case Is < 36                                '丸21 = U+3251(12881) 21から始まるため 12881 - 21 = 12860
        Let ToCircledNum = ChrW(12860 + chrNum)
    Case Is < 51                                '丸36 = U+32B1(12977) 36から始まるため 12977 - 36 = 12941
        Let ToCircledNum = ChrW(12941 + chrNum)
    Case Else                                   '51以上も非対応([]で括る)
        Let ToCircledNum = "[" & tmpAsc & "]"
    End Select
End Function

「引数には丸記号＋全角英数字の組み合わせの文字列しか来ない」という前提で作ってる関数なので、呼び出し前に正規表現やLikeマッチングでのふるい落としが必要。簡単な判定は19行目でやってるけど（引数が1文字以下なら何も返さず終了）。

やってることは洋々亭のmarumoji関数と一緒。まず全角英数字を半角英数字に置き換え（22～25行目）、整数型に変換（26行目）。あとはSelect Case文で0未満と50超は対応する丸数字がないため[]で括る、⓪と㉑～㊿はChrW関数で文字コードから文字を取得。①～⑳は文字を並べてMid関数で対応する数字の位置に該当する文字を取得。

①～⑳もChr関数を使えば取得できるが、文字を並べてMid関数で取得した方がちょっとだけ早い。

Public Sub SpeedTest()
    Dim testNums(2000000) As Long
    Dim dummyStr As String
    Dim procTime As Single
    Dim i As Long
    For i = LBound(testNums) To UBound(testNums)
        Let testNums(i) = RandomLong(1, 20)
    Next i
    Let procTime = Timer
    For i = LBound(testNums) To UBound(testNums)
        Let dummyStr = Mid$("①②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑳", testNums(i), 1)
    Next i
    Debug.Print "Test1: " & Timer - procTime        'Test1: 0.140625
    Let procTime = Timer
    For i = LBound(testNums) To UBound(testNums)
        Let dummyStr = Chr(34623 + testNums(i))
    Next i
    Debug.Print "Test2: " & Timer - procTime        'Test2: 0.171875
End Sub

Private Function RandomLong(ByRef minVal As Long, ByRef maxVal As Long, Optional ByRef doRandomize As Boolean = True) As Long
    If doRandomize Then
        Randomize
    End If
    Let RandomLong = Int(Rnd * (maxVal - minVal + 1)) + minVal
End Function

⓪～㊿を全部並べてMid関数で取得した方が分かりやすいしできるならそうしたいんだけど、VBAは内部的にUnicode文字を使用しているものの、VBEはUnicode文字をサポートしていない。

ChrW関数などを使用してUnicode文字をサポートしている出力先（例えばWord文書など）に出力すること自体は可能なので、こういった書き方になった。もっとスマートな方法はないだろうか。

別になんてこたないんだけどね。

highlightjs.orgというサイトで公開されているライブラリを使用すれば、ブログ記事とかにプログラムのコードを貼り付けると自動的にシンタックスハイライトをしてくれるらしい。

blosxomのプラグインとしてコードをシンタックスハイライトする奴を作ろうかなー、とか思ってたけど既にあったわ。という話。

というわけで、ちょっと実験。

Option Explicit

'---------------------------------------------------------------------------------------------------
' クイックソート関数（SourceArray   <配列>）
'   説明： 渡された配列の要素をクイックソート（非安定ソート）で昇順に並び替える。
'---------------------------------------------------------------------------------------------------
Public Function QuickSort(ByVal SourceArray As Variant) As Variant
    
    Dim valLEnd As Variant      '左端の値
    Dim valREnd As Variant      '右端の値
    Dim valMed As Variant       '中央値
    Dim valSwap As Variant      'バッファ（値交換用）
    Dim posLEnd As Long         '左端の位置
    Dim posREnd As Long         '右端の位置
    Dim posLEnds() As Long      '左端の位置を記憶するスタック（配列）
    Dim posREnds() As Long      '右端の位置を記憶するスタック（配列）
    Dim topStack As Long        'スタック(配列)の最大添字 ※スタック確保用
    Dim bottomStack As Long     'スタック(配列)の最小添字 ※Option Base 1 への対策用（念の為）
    Dim ptrStack As Long        'スタック（配列）のポインタ
    Dim ptrLtoR As Long         '左端から右に向かって探索するポインタ（Lポインタと呼称）
    Dim ptrRtoL As Long         '右端から左に向かって探索するポインタ（Rポインタと呼称）
    
    '初期処理
    If Not IsArray(SourceArray) Then
        Exit Function
    End If
    Let posLEnd = LBound(SourceArray)   '引数の左端の位置
    Let posREnd = UBound(SourceArray)   '引数の右端の位置
    Let bottomStack = LBound(Array())   'スタックの最小添字
    Let topStack = Int(Log(posREnd - posLEnd + 1) / Log(2)) + bottomStack  'スタックサイズはLog2(n)個で足りる
    ReDim posLEnds(topStack)            'スタック確保
    ReDim posREnds(topStack)
    Let ptrStack = bottomStack          '全体範囲をスタックにPUSH
    Let posLEnds(ptrStack) = posLEnd
    Let posREnds(ptrStack) = posREnd
    
    'メイン処理
    Do Until ptrStack < bottomStack     'すべてのスタックが処理されるまで繰り返す
        
        '探索範囲POP・値取得
        Let posLEnd = posLEnds(ptrStack)    'スタックから両端の位置を取り出す
        Let posREnd = posREnds(ptrStack)
        Let ptrLtoR = posLEnd               '両端の位置をLポインタ・Rポインタにそれぞれセット
        Let ptrRtoL = posREnd
        Let valLEnd = SourceArray(ptrLtoR)  '両端の値と中間位置の値を取得
        Let valREnd = SourceArray(ptrRtoL)
        Let valMed = SourceArray(ptrLtoR + Int((ptrRtoL - ptrLtoR) / 2))
        
        '中央値導出（左端の値・右端の値・中間位置の値、の3値から中央値を求める）
        If valLEnd > valMed Then
            If valREnd > valLEnd Then
                Let valMed = valLEnd
            ElseIf valREnd > valMed Then
                Let valMed = valREnd
            End If
        ElseIf valLEnd > valREnd Then
            Let valMed = valLEnd
        ElseIf valMed > valREnd Then
            Let valMed = valREnd
        End If
        
        '探索・値交換
        Do Until ptrLtoR > ptrRtoL          'LポインタとRポインタの位置が逆転するまで繰り返す
            Do Until SourceArray(ptrLtoR) >= valMed
                Let ptrLtoR = ptrLtoR + 1   '左から右へ、中央値以上の値の位置を探索する
            Loop
            Do Until SourceArray(ptrRtoL) <= valMed
                Let ptrRtoL = ptrRtoL - 1   '右から左へ、中央値以下の値の位置を探索する
            Loop
            If ptrLtoR > ptrRtoL Then
                Exit Do                     'LポインタとRポインタの位置が逆転したら探索・値交換を終了する
            End If
            If ptrLtoR < ptrRtoL Then       'Lポインタ＜Rポインタ であれば、左の値と右の値を交換する
                Let valSwap = SourceArray(ptrLtoR)  '（左の値は中央値以上、右の値は中央値以下になっている）
                Let SourceArray(ptrLtoR) = SourceArray(ptrRtoL)
                Let SourceArray(ptrRtoL) = valSwap
            End If
            Let ptrLtoR = ptrLtoR + 1       'Lポインタ≦Rポインタ であれば、範囲を1つずつ狭める
            Let ptrRtoL = ptrRtoL - 1
        Loop
        
        '探索範囲の分割・交換（左範囲［左端～交差したRポインタ］ 右範囲［交差したLポインタ～右端］）
        If ptrRtoL - posLEnd < posREnd - ptrLtoR Then   '※ポインタの間に要素がある場合、その要素の位置は確定
            Let ptrLtoR = ptrLtoR Xor posLEnd   '左範囲と右範囲で、範囲の広い方を先にスタックするように調整
            Let posLEnd = ptrLtoR Xor posLEnd   '何もなければ左範囲→右範囲の順でスタックするようになっている
            Let ptrLtoR = ptrLtoR Xor posLEnd   '右範囲の方が左範囲より広ければ、左右の端の位置とポインタを交換
            Let ptrRtoL = ptrRtoL Xor posREnd   '左端←→Lポインタ、Rポインタ←→右端
            Let posREnd = ptrRtoL Xor posREnd   'スタックのサイズをLog2(n)以下に抑えられるようになる
            Let ptrRtoL = ptrRtoL Xor posREnd
        End If
        
        '探索範囲（広い方）PUSH
        If posLEnd < ptrRtoL Then               '範囲内の要素が2以上あればスタックにPUSHする
            Let posLEnds(ptrStack) = posLEnd    '（1つしかない場合はその要素の位置が確定したためPUSHしない）
            Let posREnds(ptrStack) = ptrRtoL    '現在処理中のスタックは上書きされる（実質的にPOPと同じ動作）
            Let ptrStack = ptrStack + 1         'スタックポインタに1加算＝次の空きスタックへ移動
        End If
        
        '探索範囲（狭い方）PUSH
        If ptrLtoR < posREnd Then               '上記と同じ処理
            Let posLEnds(ptrStack) = ptrLtoR
            Let posREnds(ptrStack) = posREnd
            Let ptrStack = ptrStack + 1
        End If
        
        '最上位スタックへポインタ移動
        Let ptrStack = ptrStack - 1
    Loop
    Let QuickSort = SourceArray
End Function

コードは前に何かで使ったクイックソート。さて、どうかな？