Option Explicit
 
Public Sub 納品対象外部品()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim wrow As Long
    Dim no_blk As Long
    Dim str As String
    Dim bno As Long
    Dim ino As Long
    Set ws = ActiveSheet
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).row
    If lastRow < 4 Or (lastRow - 1) Mod 3 <> 0 Then
        Call error(ws, lastRow, "最終行不正")
    End If
    no_blk = (lastRow - 1) \ 3
    ws.Range("B2:B" & lastRow).ClearContents
    For bno = 1 To no_blk
        Dim rowA As Long: rowA = 0
        Dim rowB As Long: rowB = 0
        Dim rowH As Long: rowH = 0
        Dim row_mark As Long: row_mark = 0
        Dim pv_wd As String: pv_wd = ""
        Dim en_wd As String
        For ino = 1 To 3
            wrow = (bno - 1) * 3 + ino + 1
            str = ws.Cells(wrow, 1).Value
            Dim wd As String
            Select Case Right(str, 1)
            Case "A"
                If rowA <> 0 Then Call error(ws, wrow, "終端文字Aが2回出現")
                rowA = wrow
                wd = Left(str, Len(str) - 1)
            Case "B"
                If rowB <> 0 Then Call error(ws, wrow, "終端文字Bが2回出現")
                rowB = wrow
                wd = Left(str, Len(str) - 1)
            Case "H"
                If rowH <> 0 Then Call error(ws, wrow, "終端文字Hが2回出現")
                rowH = wrow
                en_wd = Right(str, 2)
                Select Case en_wd
                Case "AH"
                Case "BH"
                Case Else
                    Call error(ws, wrow, "終端文字がAH,BHの何れかでない")
                End Select
                wd = Left(str, Len(str) - 2)
            Case Else
                Call error(ws, wrow, "終端文字がA,B,Hの何れかでない")
            End Select
            If pv_wd = "" Then
                pv_wd = wd
            Else
                If pv_wd <> wd Then Call error(ws, wrow, "部番の共通文字が不一致")
            End If
        Next
        If en_wd = "AH" Then row_mark = rowA
        If en_wd = "BH" Then row_mark = rowB
        If row_mark = 0 Then Call error(ws, wrow, "納品対象外行が決定できない")
        ws.Cells(row_mark, 2).Value = "-"
    Next
    MsgBox ("完了")
End Sub
Private Sub error(ws As Worksheet, ByVal rowNo As Long, ByVal msg As String)
    ws.Cells(rowNo, 1).Select
    MsgBox (msg)
    End
End Sub
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIOe0jeWTgeWvvuixoeWklumDqOWTgSgpCiAgICBEaW0gd3MgQXMgV29ya3NoZWV0CiAgICBEaW0gbGFzdFJvdyBBcyBMb25nCiAgICBEaW0gd3JvdyBBcyBMb25nCiAgICBEaW0gbm9fYmxrIEFzIExvbmcKICAgIERpbSBzdHIgQXMgU3RyaW5nCiAgICBEaW0gYm5vIEFzIExvbmcKICAgIERpbSBpbm8gQXMgTG9uZwogICAgU2V0IHdzID0gQWN0aXZlU2hlZXQKICAgIGxhc3RSb3cgPSB3cy5DZWxscyhSb3dzLkNvdW50LCAxKS5FbmQoeGxVcCkucm93CiAgICBJZiBsYXN0Um93IDwgNCBPciAobGFzdFJvdyAtIDEpIE1vZCAzIDw+IDAgVGhlbgogICAgICAgIENhbGwgZXJyb3Iod3MsIGxhc3RSb3csICLmnIDntYLooYzkuI3mraMiKQogICAgRW5kIElmCiAgICBub19ibGsgPSAobGFzdFJvdyAtIDEpIFwgMwogICAgd3MuUmFuZ2UoIkIyOkIiICYgbGFzdFJvdykuQ2xlYXJDb250ZW50cwogICAgRm9yIGJubyA9IDEgVG8gbm9fYmxrCiAgICAgICAgRGltIHJvd0EgQXMgTG9uZzogcm93QSA9IDAKICAgICAgICBEaW0gcm93QiBBcyBMb25nOiByb3dCID0gMAogICAgICAgIERpbSByb3dIIEFzIExvbmc6IHJvd0ggPSAwCiAgICAgICAgRGltIHJvd19tYXJrIEFzIExvbmc6IHJvd19tYXJrID0gMAogICAgICAgIERpbSBwdl93ZCBBcyBTdHJpbmc6IHB2X3dkID0gIiIKICAgICAgICBEaW0gZW5fd2QgQXMgU3RyaW5nCiAgICAgICAgRm9yIGlubyA9IDEgVG8gMwogICAgICAgICAgICB3cm93ID0gKGJubyAtIDEpICogMyArIGlubyArIDEKICAgICAgICAgICAgc3RyID0gd3MuQ2VsbHMod3JvdywgMSkuVmFsdWUKICAgICAgICAgICAgRGltIHdkIEFzIFN0cmluZwogICAgICAgICAgICBTZWxlY3QgQ2FzZSBSaWdodChzdHIsIDEpCiAgICAgICAgICAgIENhc2UgIkEiCiAgICAgICAgICAgICAgICBJZiByb3dBIDw+IDAgVGhlbiBDYWxsIGVycm9yKHdzLCB3cm93LCAi57WC56uv5paH5a2XQeOBjDLlm57lh7rnj74iKQogICAgICAgICAgICAgICAgcm93QSA9IHdyb3cKICAgICAgICAgICAgICAgIHdkID0gTGVmdChzdHIsIExlbihzdHIpIC0gMSkKICAgICAgICAgICAgQ2FzZSAiQiIKICAgICAgICAgICAgICAgIElmIHJvd0IgPD4gMCBUaGVuIENhbGwgZXJyb3Iod3MsIHdyb3csICLntYLnq6/mloflrZdC44GMMuWbnuWHuuePviIpCiAgICAgICAgICAgICAgICByb3dCID0gd3JvdwogICAgICAgICAgICAgICAgd2QgPSBMZWZ0KHN0ciwgTGVuKHN0cikgLSAxKQogICAgICAgICAgICBDYXNlICJIIgogICAgICAgICAgICAgICAgSWYgcm93SCA8PiAwIFRoZW4gQ2FsbCBlcnJvcih3cywgd3JvdywgIue1guerr+aWh+Wtl0jjgYwy5Zue5Ye654++IikKICAgICAgICAgICAgICAgIHJvd0ggPSB3cm93CiAgICAgICAgICAgICAgICBlbl93ZCA9IFJpZ2h0KHN0ciwgMikKICAgICAgICAgICAgICAgIFNlbGVjdCBDYXNlIGVuX3dkCiAgICAgICAgICAgICAgICBDYXNlICJBSCIKICAgICAgICAgICAgICAgIENhc2UgIkJIIgogICAgICAgICAgICAgICAgQ2FzZSBFbHNlCiAgICAgICAgICAgICAgICAgICAgQ2FsbCBlcnJvcih3cywgd3JvdywgIue1guerr+aWh+Wtl+OBjEFILEJI44Gu5L2V44KM44GL44Gn44Gq44GEIikKICAgICAgICAgICAgICAgIEVuZCBTZWxlY3QKICAgICAgICAgICAgICAgIHdkID0gTGVmdChzdHIsIExlbihzdHIpIC0gMikKICAgICAgICAgICAgQ2FzZSBFbHNlCiAgICAgICAgICAgICAgICBDYWxsIGVycm9yKHdzLCB3cm93LCAi57WC56uv5paH5a2X44GMQSxCLEjjga7kvZXjgozjgYvjgafjgarjgYQiKQogICAgICAgICAgICBFbmQgU2VsZWN0CiAgICAgICAgICAgIElmIHB2X3dkID0gIiIgVGhlbgogICAgICAgICAgICAgICAgcHZfd2QgPSB3ZAogICAgICAgICAgICBFbHNlCiAgICAgICAgICAgICAgICBJZiBwdl93ZCA8PiB3ZCBUaGVuIENhbGwgZXJyb3Iod3MsIHdyb3csICLpg6jnlarjga7lhbHpgJrmloflrZfjgYzkuI3kuIDoh7QiKQogICAgICAgICAgICBFbmQgSWYKICAgICAgICBOZXh0CiAgICAgICAgSWYgZW5fd2QgPSAiQUgiIFRoZW4gcm93X21hcmsgPSByb3dBCiAgICAgICAgSWYgZW5fd2QgPSAiQkgiIFRoZW4gcm93X21hcmsgPSByb3dCCiAgICAgICAgSWYgcm93X21hcmsgPSAwIFRoZW4gQ2FsbCBlcnJvcih3cywgd3JvdywgIue0jeWTgeWvvuixoeWkluihjOOBjOaxuuWumuOBp+OBjeOBquOBhCIpCiAgICAgICAgd3MuQ2VsbHMocm93X21hcmssIDIpLlZhbHVlID0gIi0iCiAgICBOZXh0CiAgICBNc2dCb3ggKCLlrozkuoYiKQpFbmQgU3ViClByaXZhdGUgU3ViIGVycm9yKHdzIEFzIFdvcmtzaGVldCwgQnlWYWwgcm93Tm8gQXMgTG9uZywgQnlWYWwgbXNnIEFzIFN0cmluZykKICAgIHdzLkNlbGxzKHJvd05vLCAxKS5TZWxlY3QKICAgIE1zZ0JveCAobXNnKQogICAgRW5kCkVuZCBTdWIK