[[20130408163859]]　『VBAでLEFTB的なものを再現する高速な手法は?』(白茶) 　ページの最後に飛ぶ

『VBAでLEFTB的なものを再現する高速な手法は?』(白茶)

 ほぼ趣味の世界のお話なので、おヒマでしたらお付き合いください。

 ワークシート関数のLEFTBに似たFunctionで、
 条件１「全角をちょん切ってしまった場合は半角スペースに補正して桁を揃える」
 条件２「LEFTBとは違って、ChrW(12958)の様な文字は2桁として計算する」
 というのをVBA上で再現しようと、いろいろ試しています。

●ボツ案１

 Application.Evaluateで再現する方法。

   Evaluateの引数文字列が512桁を超えるとエラーになる。
   条件２をクリアできない。

●ボツ案２

 予め末尾に半角スペースを１つ付けた上で、
 WorksheetFunction.ReplaceBで指定桁数超過部分を空白に置き換える。

   長い文字列でもイケるが、条件２をクリアできない。

●ボツ案３

 １文字ずつ順番に取り出して検査しながら
 指定桁数に達するまでLENB相当のバイト数を足算。
 (StrConvでvbFromUnicodeに変換した文字とvbUnicodeに戻した文字とが違ったら2を
 それ以外はvbFromUnicodeに変換した文字のLenBを足算)
 ループを抜けた時点での文字数分をLeft$で取り出した後、
 足算結果と指定桁数に差があったら尻に差分のスペースを追加。

   とにかく遅い。
   10万回ループでの速度比較では、
   10桁の文字でもReplaceBに負ける。
   100桁くらいで既に差を体感する様になり、
   1000桁くらいになってくると、もう目も当てられない・・・

●ボツ案４

 ボツ案３の検査方法をAscW関数に変更

   StrConvしない分、目も当てられない事は無くなったけど、
   10万回ループでの速度比較では、
   100桁くらいでも１秒以上かかるし、
   1000桁だと10秒もかかってしまう。

●現行案

 ボツ案３の検査方法をバイト配列に変更
 バイト配列に変換して、２バイトずつ取り出しては、前バイトと後バイトを検査しながら
 指定桁数に達するまでLENB相当のバイト数を足算。
 ループを抜けた時点での文字数分をUnicodeのままLeftB$で取り出した後、
 足算結果と指定桁数に差があったら尻に差分のスペースを追加。

   10万回ループでの速度比較では、
   100桁の文字列だとReplaceBと引き分けくらい(どちらも１秒未満で勝ったり負けたり)
   1000桁だと敗けました(１秒超の差)。

   ちなみに1万桁の文字列だと、差は顕著で、
   StrConv(LeftB$(StrConv(文字列, vbFromUnicode), 長さ), vbUnicode)
   が7.5秒程度で処理するのに対し、
   ReplaceBが20秒、現行案が30秒でした。

 ここでネタが尽きました。
 というか、これくらいが限界なのかなぁ・・・と思いつつ、

 そもそも皆さんならどんなアプローチで処理するのでしょうか?

 100桁台の文字列ならコレでもReplaceBより速いですが、
 LeftB$くらい高速に動作する事までは望まないとしても、
 せめて1000桁でもReplaceBより早く処理する方法は無いでしょうか?

 まったりとアドバイスお願いします。

 早いかどうかは全く分からないし、正しいかどうかも分からない無責任レス。

 VBAのLEFTBで取り出した文字列の最後の文字　Right(その文字列,1) が、なんとなく ASCコードで　63 になっているみたい？？(Win7のxl2010)
 であれば、63 なら最後の文字を半角スペースで置き換えるとか。

 まったく、いいかげんな発言かな？
 大きく外している公算大・・・・

 (ぶらっと)

 ぶらっとさんレスありがとうございます。

 >VBAのLEFTBで取り出した文字列の最後の文字
 確かに。これボツ案２と３の間で遭遇しましたね。

 ただ、LeftB$でS-JIS換算のバイト指定取り出しを
 vbFromUnicode変換せずに行う方法が分らなかったので
 「条件２」をクリアできず、ボツ案３以降の流れになってました。

 そこら辺って上手い処理方法あるんでしょうか?

 (白茶)

 >そこら辺って上手い処理方法あるんでしょうか?

 いやぁ。。。。いろいろ試してみると 63 も、何か別のもののようだし・・・
 お役に立てそうにないです。

 (ぶらっと)

 いえいえ、お付き合いいただきありがとうございます。

 どうやら63は「?」のキャラコードみたいですね。
 S-JISにマッピングされていない文字をvbFromUnicode変換した時に「?」になるから、か・・・

 私もさっきのレスは勘違いしてたみたいで、
 私の遭遇したのは全角の前半バイトにAsc関数かけると「0」を返す。
 というやつだったみたいです。

 またなんかひらめいたら、ぜひお願いします。

 (白茶)

 すみません。２箇所ほど記述を訂正します。ウソ書いてました。

 >条件２「LEFTBとは違って、ChrW(12958)の様な文字は2桁として計算する」

 誤:LEFTBとは違って
 正:LENBとは違って

 >●ボツ案３
 >(StrConvでvbFromUnicodeに変換した文字とvbUnicodeに戻した文字とが違ったら2を

 誤:vbFromUnicodeに変換した文字
 正:vbFromUnicodeに変換する前の文字

 (白茶)

 もうちょっと経緯を説明した方が良いかしら・・・

 実はボツ案２は、非常に惜しいのです。

 末尾が全角文字で、指定桁数がその末尾文字を分断する場所だった場合、
 ReplaceB関数自体が末尾の全角文字を分断出来ないので、
 (REPLACEB("あ",2,1,"") => "あ" が返る)
 予め末尾に半角スペースを付けてReplaceBで後ろを全部消しちゃうのですが、
 (REPLACEB("あ"&" ",2,1+LEN(" "),"") => 半角スペース１個 が返る)

 出てくるのがS-JISの全角のみであれば、これでイケます。
 ところがChrW(12958)の様な文字が混在した場合は、このやり方が通用しません。

 というのが、
 そもそも桁数の指定が対象文字列の桁数より大きかった場合に、
 本来無いはずの半角スペースが末尾に付いたままの答えが返ってくるので、
 ReplaceBの処理以前に、対象文字列の桁数と指定桁数の比較で処理を分岐させるのですが、
 当然桁数の算出にLenB関数を使います。
 当然StrConvでvbFromUnicodeに変換します。
 ChrW(12958)は「?」に変換されて1桁扱いになってしまいます。
 結果、桁数の比較に失敗してReplaceBで後ろを消す処理に流れないパターンが発生してしまいます。

 LenBだけ自作する?
 いや、それやっちゃうならReplaceBを使う意味がない。

 じゃあ、
 末尾に付ける文字を半角スペースじゃなく、もっと特殊な文字にして
 あえて対象文字列の桁数と指定桁数の事前比較を行わないでReplaceBし、
 結果として残ってたらソイツだけ消す。

 という流れも考えたのですが、
 「特殊な文字」って何使えばいいんだろ?
 vbNullCharで試したら何も付けてないのと同じ扱いになってしまいました。
 改行文字もタブも対象文字列内で使用する可能性はあるし・・・

 で、ボツ案３以降へと突入したのです。

 ReplaceBの上記問題をクリアできれば、
 短い文字列は現行案で、長い文字列はReplaceBで処理
 というちょっとセコい解決策もあるんですけどね・・・

 (白茶)

わぁー・・・ orz

 なんで今まで気付かんかったんだろ。
 のめり込んだら当たり前のことが見えなくなったの典型でした。

 別に「特殊な文字」なんぞ使わなくたって、
 Lenで文字数超過を確認すれば良いだけじゃないの。

 ボツ案２は、ボツ撤回。
 現行案に取り入れました。

 Function xlLeftB(String1 As String, Length As Long) As String
    Rem ▼▼長さ指定ゼロなら即終了
    If Length < 1 Then Exit Function
    Rem ▼▼100文字超の文字列に対して200桁超の切り出しを行う際はReplaceB関数を使って速度を稼ぐ
    Dim i As Long
    If Len(String1) > 100 And Length > 200 Then
        i = Len(String1)
        Rem ▼REPLACEBは末尾の全角削除が苦手なので、末尾に一文字付けてから処理
        xlLeftB = Application.WorksheetFunction.ReplaceB(String1 & Space$(1), Length + 1, i * 2 + 1, "")
        Rem ▼String1より長い文字列だったらString1を返す
        If Len(xlLeftB) > i Then xlLeftB = String1
        Exit Function
    End If
    Rem ▼▼それ以下の場合は関数の呼び出しオーバーヘッドで逆に遅くなると見越して自前処理
    Dim c() As Byte, StrLenB As Long, j As Long
    Rem ▼バイト配列にキャストしてLENB算出及び加算
    c = String1
    For i = LBound(c) + 1 To UBound(c) Step 2
        'j = LenBfromWByte(c(i - 1), c(i)) '←廃止
        Select Case c(i)
            Case 0&
                Select Case c(i - 1)
                    Case 0& To 128&, 160&, 253& To 255&: j = 1
                    Case Else: j = 2
                End Select
            Case 255&
                Select Case c(i - 1)
                    Case 97& To 159&: j = 1
                    Case Else: j = 2
                End Select
            Case Else: j = 2
        End Select
        If StrLenB + j > Length Then Exit For '長さ指定に達する直前でループ抜け
        StrLenB = StrLenB + j
    Next
    Rem ▼算出バイト位置でLEFT
    xlLeftB = LeftB$(String1, (i - 1))
    If xlLeftB = String1 Then Exit Function
    Rem ▼桁足らずだった場合はスペースを補う
    If Length - StrLenB > 0 Then xlLeftB = xlLeftB & Space$(Length - StrLenB)
 End Function

 実際には短い文字列で処理速度なんて気にならないだろうし、
 せっかくExcelなんだから、ExcelらしくReplaceB一択処理でも構わない気がしてきました・・・。

 (白茶)

コメント返信：

[ 一覧(最新更新順) ]

[[20130408163859]] 『VBAでLEFTB的なものを再現する高速な手法は?』(白茶) ページの最後に飛ぶ

[[20130408163859]]　『VBAでLEFTB的なものを再現する高速な手法は?』(白茶) 　ページの最後に飛ぶ