振分 (正規表現)

Sub UpdateDColumnWithRegex()
    Dim regex As Object
    Dim lastRow As Long
    Dim i As Long
    
    ' 正規表現オブジェクトを作成
    Set regex = CreateObject("VBScript.RegExp")
    
    ' パターンを設定
    regex.IgnoreCase = True
    regex.Global = True
    
    ' 最終行を取得
    lastRow = Cells(Rows.Count, "C").End(xlUp).Row
    
    ' ループして条件に基づいてD列を更新
    For i = 1 To lastRow
        ' 文字列から最初の文字を取得
        Dim firstChar As String
        firstChar = Left(Cells(i, "C").Value, 1)
        
        ' 正規表現パターンに一致するかチェック
        If firstChar Like "#" Then
            If Left(Cells(i, "C").Value, 2) = "test1" Or Left(Cells(i, "C").Value, 2) = "test2" Then
                Cells(i, "D").Value = "その他２"
            Else
                Cells(i, "D").Value = "その他"
            End If
        ElseIf regexTest(regex, Cells(i, "C").Value, "TNY.*Z.*") Then
            Cells(i, "D").Value = "A211"
        ElseIf regexTest(regex, Cells(i, "C").Value, "TNY.*Y.*") Then
            Cells(i, "D").Value = "A211"
        ElseIf regexTest(regex, Cells(i, "C").Value, "TNY.*X.*") Then
            Cells(i, "D").Value = "A213"
        ElseIf regexTest(regex, Cells(i, "C").Value, "TNY.*") Then
            Cells(i, "D").Value = "A213"
        ElseIf regexTest(regex, Cells(i, "C").Value, "TRY.*") Then
            Cells(i, "D").Value = "B222"
        Else
            Cells(i, "D").Value = "A211"
        End If
    Next i
    
    ' 正規表現オブジェクトを解放
    Set regex = Nothing
End Sub

Function regexTest(regex As Object, str As String, pattern As String) As Boolean
    regex.Pattern = pattern
    regexTest = regex.Test(str)
End Function