概要
固定長の文字列を取得する関数です。
固定長の長さの計算をするのに、Unicodeからシステム規定コードに変換してバイト数を数えています。
コード
Function 固定長の文字列取得(strOriginal As Variant, lngLength As Integer, blnAddAbbCchar As Boolean)
'------------------------------------------------------------------------------
' 指定した長さの固定長文字列を返す(不足時は半角空白パディング)
'
' strOriginal :元の文字列
' lngLength :固定長にするときの長さ(半角1バイト全角2バイトとした場合の長さ)
' blnAddAbbCchar :後略記号「…」を追加するか(True:追加する、False:追加しない)
'------------------------------------------------------------------------------
Dim strWork As Variant '固定長変換後の文字列取得のためのワーク
Dim lngDefChrCount As Long 'システム規定コードでの長さ
'--------------------------------------
'入力値チェック
'--------------------------------------
'文字列が空白
If strOriginal = "" Then
固定長の文字列取得 = "固定長取得エラー"
Exit Function
End If
'後略記号を追加する場合は、後略記号分の長さを引く
If blnAddAbbCchar = True Then
lngLength = lngLength - 2
End If
'長さが0以下
If lngLength <= 0 Then
固定長の文字列取得 = "固定長取得エラー"
Exit Function
End If
'--------------------------------------
'指定の長さにする
'--------------------------------------
'(1) 改行削除(改行がカウントされてしまうため、改行は削除)
strWork = Replace(strOriginal, vbLf, "")
strWork = Replace(strWork, vbLf, "")
strWork = Replace(strWork, vbCrLf, "")
'(2) 指定の長さにする
'システム規定コードでの長さ(Unicodeからシステム規定コードへ変換してカウント)
lngDefChrCount = LenB(StrConv(strWork, vbFromUnicode))
'指定の長さで切る
strWork = StrConv(MidB(StrConv(strWork, vbFromUnicode), 1, lngLength), vbUnicode)
'文字のバイト途中で切ったときの空白置換と空白パディングの処理
'指定の長さに切ったときにちょうどの長さになった
If LenB(MidB(StrConv(strWork, vbFromUnicode), 1, lngLength)) = lngLength Then
'末尾「・」の場合、無条件に半角スペースに置換(文字の途中のバイトで切ってしまうと「・」になるため)
If Right(strWork, 1) = "・" Then
strWork = Left(strWork, Len(strWork) - 1) & " "
End If
Else
'指定の長さに足りない分を、空白パディング
strWork = strWork & String(lngLength - LenB(StrConv(strWork, vbFromUnicode)), " ")
End If
'--------------------------------------
'後略記号追加
'--------------------------------------
'指定文字数より長い場合に、省略記号「…」を入れる
If blnAddAbbCchar = True Then
If lngDefChrCount > lngLength Then
'「…」(Unicode:8230)を追加
strWork = strWork & WorksheetFunction.Unichar(8230)
Else
'長くないため、文字数合わせとして「…」分の半角空白追加
strWork = strWork & " "
End If
End If
'--------------------------------------
'文字列返却
'--------------------------------------
固定長の文字列取得 = strWork
End Function
