Created
June 12, 2012 03:57
-
-
Save nobrinskii/2914805 to your computer and use it in GitHub Desktop.
[vba/excel]文字列中の数字を漢数字に置き換える
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Public Sub sample() | |
Const strExample As String = "今日は1月12日です。" | |
Debug.Print ConvertNumbersToKanSuji(strExample) | |
End Sub | |
'------------------------------------------------------------------------------- | |
'文字列中の数字を漢数字に置き換える | |
'------------------------------------------------------------------------------- | |
'【引数】文字列 | |
'【戻り値】数字を漢数字に置き換えた文字列 | |
'【備考】日付を変換することを想定しているため「百五十二」のような形式に変換する。 | |
Private Function ConvertNumbersToKanSuji(strInputed As String) As String | |
Const strPattern = "[0-9]+" | |
Dim strTarget As String | |
Dim RE As Object | |
Dim objMatches As Object | |
Dim i As Long | |
Dim z As Long | |
Dim strNumber As String | |
Dim strKanSuji As String | |
If strInputed = "" Then | |
Exit Function | |
Else | |
strTarget = strInputed | |
End If | |
Set RE = CreateObject("VBScript.RegExp") | |
With RE | |
.Pattern = strPattern | |
.Global = True | |
Set objMatches = .Execute(strTarget) | |
End With | |
RE.Global = False | |
If objMatches.Count > 0 Then | |
z = objMatches.Count - 1 | |
For i = 0 To z | |
strNumber = objMatches(i).Value | |
strKanSuji = GetKanSujiNumber(strNumber) | |
With RE | |
.Pattern = strNumber | |
strTarget = .Replace(strTarget, strKanSuji) | |
End With | |
Next i | |
End If | |
Set objMatches = Nothing | |
Set RE = Nothing | |
ConvertNumbersToKanSuji = strTarget | |
End Function | |
'------------------------------------------------------------------------------- | |
'数字の文字列を漢数字の文字列に変換する | |
'------------------------------------------------------------------------------- | |
'【引数】数字の文字列、(NumberString関数のオプション(1,2,3)) | |
'【戻り値】漢数字の文字列 | |
'【備考】引数intOptionが渡されない場合は1とする。 | |
' オプションによる違いは以下の通り("152"の例) | |
' 1:百五十二 | |
' 2:壱百伍拾弐 | |
' 3:一五二 | |
Private Function GetKanSujiNumber(strNumber As String, Optional intOption As Variant) As String | |
Dim strFormula As String | |
If IsMissing(intOption) Then | |
intOption = 1 | |
ElseIf intOption < 1 Or intOption > 3 Then | |
Exit Function | |
End If | |
strFormula = "=NumberString(" & strNumber & ", " & CStr(intOption) & ")" | |
GetKanSujiNumber = Evaluate(strFormula) | |
End Function |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment