【vba】住所内の数字を漢数字表示に変換する

white Unsplash mail letter Excel・VBA
スポンサーリンク

むかーしに作った部品が最近、再度必要になったので掘り起こし。

XLSTARTにあるマクロファイルにしか存在しなかったので、

記事化して保存。

以下のコードをvbaのモジュールにペタッと貼り付ければOK。

Public Sub convertAddressNum2Kanji()

    ' 変数定義
    Dim startPos As Range
    Dim outputPos As Range
    Dim rowOffset As Integer
    Dim convertAddress As String
    
    ' 初期値設定
    Set startPos = Range("H7") ' 変換対象列
    Set outputPos = Range("I7") ' 変換後出力列
    rowOffset = 0
    
    While startPos.Offset(rowOffset, 0).Value <> ""
        
        Dim i As Integer
        For i = 0 To 2
        
            If startPos.Offset(rowOffset, i).Value <> "" Then
        
                ' 住所の変換
                convertAddress = convertMain(startPos.Offset(rowOffset, i).Value)
                
                ' 変換後住所の出力
                outputPos.Offset(rowOffset, i).Value = convertAddress
        
            End If
        
        Next i
    
        rowOffset = rowOffset + 1
    
    Wend
    
    MsgBox ("住所変換完了")

End Sub

Private Function convertMain(target As String) As String

    Dim output As String
    output = ""
    
    Dim i As Integer
    For i = 1 To Len(target)
    
        ' 漢数字変換対象文字列
        Dim numericString As String
        numericString = ""
    
        If IsNumeric(Mid(target, i, 1)) Then
        
            numericString = Mid(target, i, 1)
        
            ' 数字が続く分だけ変換文字にセットする
            Dim j As Integer
            For j = i + 1 To Len(target)
            
                If IsNumeric(Mid(target, j, 1)) Then
                
                    numericString = numericString & Mid(target, j, 1)
                
                Else
                    
                    ' 数値でなくなったら終了する
                    Exit For
                
                End If
            
            Next j
            
            ' 変換対象文字列の分だけループ変数を進める
            i = i + (Len(numericString) - 1)
            
            ' 漢数字変換対象を変換
            output = output & convertKanjiNum(numericString)
        
        Else
        
            output = output & Mid(target, i, 1)
        
        End If
    
    
    Next i
    
    convertMain = output

End Function

Private Function convertKanjiNum(target As String) As String

    Dim output As String
    output = ""

    If Len(target) = 1 Then
    
        output = numToKanji(target)
    
    ElseIf Len(target) = 2 Then
    
        '最初が1
        If Mid(target, 1, 1) = "1" Or Mid(target, 1, 1) = "1" Then
        
            output = "十"
            
            ' 0の場合は追加しない
            If Mid(target, 2, 1) <> "0" And Mid(target, 2, 1) <> "0" Then
            
                output = output & numToKanji(Mid(target, 2, 1))
            
            End If
            
        
        '最初が1以外
        Else
        
            output = numToKanji(Mid(target, 1, 1)) & "十"
            
            ' 0の場合は追加しない
            If Mid(target, 2, 1) <> "0" And Mid(target, 2, 1) <> "0" Then
            
                output = output & numToKanji(Mid(target, 2, 1))
            
            End If
        
        End If
    
    Else
    
        Dim i As Integer
        For i = 1 To Len(target)
        
            output = output & numToKanji(Mid(target, i, 1))
        
        Next i
    
    End If

    convertKanjiNum = output

End Function

Private Function numToKanji(target As String) As String

    If target = "1" Or target = "1" Then
    
        numToKanji = "一"
        Exit Function
    
    ElseIf target = "2" Or target = "2" Then
    
        numToKanji = "二"
        Exit Function
    
    ElseIf target = "3" Or target = "3" Then
    
        numToKanji = "三"
        Exit Function
    
    ElseIf target = "4" Or target = "4" Then
    
        numToKanji = "四"
        Exit Function
    
    ElseIf target = "5" Or target = "5" Then
    
        numToKanji = "五"
        Exit Function
    
    ElseIf target = "6" Or target = "6" Then
    
        numToKanji = "六"
        Exit Function
    
    ElseIf target = "7" Or target = "7" Then
    
        numToKanji = "七"
        Exit Function
    
    ElseIf target = "8" Or target = "8" Then
    
        numToKanji = "八"
        Exit Function
    
    ElseIf target = "9" Or target = "9" Then
    
        numToKanji = "九"
        Exit Function
    
    ElseIf target = "0" Or target = "0" Then
    
        numToKanji = "〇"
        Exit Function
        
    Else
    
        numToKanji = ""
        Exit Function
    
    End If

End Function

コメント

タイトルとURLをコピーしました