VBAを用いた文字列処理の備忘録

Excelで下記の処理を行うVBAを用いた文字列処理の備忘録

行いたい処理としては：

(1) 文字(漢字、平仮名)と半角数字からなる文字列 (例. あいう123え4567) を先頭から"え"までと下4桁の数字に分解したい。

(2) 上の例に示した文字列の場合、"え"の箇所は必ず任意の1文字の平仮名であり、カタカナに変換 (例の場合"エ")したい。

(3) 下4桁の数字の桁数は、1桁から4桁の数字になり得る。なお、4桁に満たない場合、･ (半角中黒) を挿入したい。

(4) 選択したセルの1つ右隣のセルに(1)と(2)の処理結果を出力

RemoveRightDigits()

Sub RemoveRightDigits()
    Dim cell As Range
    For Each cell In Selection.Cells
        Dim str As String
        str = cell.Value
        Dim i As Integer
        For i = Len(str) To 1 Step -1
            If isNumeric(Right(str, i)) And i <= 4 Then
                cell.Offset(0, 1).Value = Left(str, Len(str) - i - 1) & StrConv(Mid(str, Len(str) - i, 1), vbKatakana)
                Exit For
            End If
        Next i
    Next cell
End Sub

(5) 選択したセルの2つ右隣のセルに(1)と(3)の処理結果を出力

ExtractNumber()

Sub ExtractNumber()
    Dim rng As Range
    Dim str As String
    Dim i As Integer, j As Integer
    Dim num As String
    Dim cell As Range
    
    Set rng = Selection
    
    For Each cell In rng
        str = cell.Value
        
        For i = Len(str) To 1 Step -1
            If isNumeric(Mid(str, i, 1)) Then
                num = Mid(str, i, 1) & num
                j = j + 1
            Else
                If j > 0 And j < 5 Then
                    cell.Offset(0, 2).Value = num
                    Exit For
                End If
                num = ""
                j = 0
            End If
        Next i
        
        num = ""
        j = 0
    Next cell
End Sub

AddDotToShortNum()

Sub AddDotToShortNum()
    Dim r As Range
    Dim cell As Range
    Dim num As String
    
    Set r = Selection.Offset(0, 2)
    
    For Each cell In r.Cells
        num = Right(cell.Value, 4)
        If isNumeric(num) And Len(num) < 4 Then
            num = String(4 - Len(num), "･") & num
            cell.Offset(0, 0).Value = num
            Else
            cell.Offset(0, 0).Value = cell.Value
        End If
    Next cell
End Sub

(6) (4), (5)の文字列を結合した処理結果を選択したセルの3つ右隣のセルに出力

ConcatenateNextCellValues()

Sub ConcatenateNextCellValues()
    Dim rng As Range
    Dim cell As Range
    
    Set rng = Selection
    
    For Each cell In rng
        If Not cell.Offset(0, 1).Value = "" And Not cell.Offset(0, 2).Value = "" Then
            cell.Offset(0, 3).Value = cell.Offset(0, 1).Value & cell.Offset(0, 2).Value
        End If
    Next cell
End Sub

(7) 一連の処理を連続して実行する

連続実行()

Sub 連続実行()
    Call RemoveRightDigits
    Call ExtractNumber
    Call AddDotToShortNum
    Call ConcatenateNextCellValues
End Sub

このVBAの実行方法

全てのコードを入力後、変換したい文字列が入力されているセルを選択して、"連続実行()"を実行することで結果が得られる。