LoginSignup
7

More than 5 years have passed since last update.

VBAでサロゲートペア対応Len

Last updated at Posted at 2016-06-12

サロゲートペアに対応したLEN

テストしてみたらLENがサロゲートペアに対応していなかったので作成。

サロゲートペア対応Len
'--------------------------------------------------------------
'  サロゲートペア対応Len
'--------------------------------------------------------------
Function LenEx(ByVal strBuf As String) As Long

    Dim bytBuf() As Byte
    Dim lngBuf As Long
    Dim i As Long
    Dim lngLen As Long

    lngLen = 0

    If Len(strBuf) = 0 Then
        LenEx = 0
        Exit Function
    End If

    bytBuf = strBuf

    For i = LBound(bytBuf) To UBound(bytBuf) Step 2

        lngBuf = LShift(bytBuf(i + 1), 8) + bytBuf(i)

        Select Case lngBuf
            '上位サロゲート
            Case &HD800& To &HDBFF&
                lngLen = lngLen + 1
            '下位サロゲート
            Case &HDC00& To &HDFFF&
                'カウントしない
            Case Else
                lngLen = lngLen + 1
        End Select

    Next

    LenEx = lngLen

End Function
'------------------------------------------------------------------------------------------------------------------------
' 左シフト
'------------------------------------------------------------------------------------------------------------------------
Function LShift(ByVal lngValue As Long, ByVal lngKeta As Long) As Long
    LShift = lngValue * (2 ^ lngKeta)
End Function

他のソースをごらんになりたい方はこちらへ
Excelを便利にする250以上の機能を体系化したアドインはこちらです。
「RelaxTools Addin」窓の杜大賞受賞ソフト
http://software.opensquare.net/relaxtools/

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
7