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 = "その他2"
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