hiko-blog

VBA業務改善

MENU

条件 振り分け2

Sub UpdateDColumnWithRegex555()
    Dim regex As Object
    Dim lastRow As Long
    Dim i As Long
    '参照設定  Microsoft VBScript Regular Expressions 5.5
    ' 正規表現オブジェクトを作成
    Set regex = CreateObject("VBScript.RegExp")
    
    ' パターンを設定
    regex.IgnoreCase = True
    regex.Global = True
    
    ' 最終行を取得
    lastRow = Cells(Rows.Count, "C").End(xlUp).Row
    
    ' ループして条件に基づいてD列を更新
    For i = 2 To lastRow
        ' 正規表現パターンに一致するかチェック
        If regexTest(regex, Cells(i, "C").Value, "Test.*Z.*") Then
            Cells(i, "D").Value = "test1"
        ElseIf regexTest(regex, Cells(i, "C").Value, "Test.*Y.*") Then
            Cells(i, "D").Value = "test1"
        ElseIf regexTest(regex, Cells(i, "C").Value, "Test.*X.*") Then
            Cells(i, "D").Value = "test2"
        ElseIf regexTest(regex, Cells(i, "C").Value, "Test.*") Then
            Cells(i, "D").Value = "test2"
        ElseIf regexTest(regex, Cells(i, "C").Value, "RRR.*") Then
            Cells(i, "D").Value = "test3"
        Else
            Cells(i, "D").Value = "test1"
        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