Option Explicit
 
Public Sub 非表示()
    Dim wrow As Long
    Dim ws As Worksheet
    Dim dicROW As Object
    Dim dicPC As Object
    Dim maxrow As Long
    Dim key As Variant
    Dim cellE As String
    Dim elms As Variant
    Dim i As Long
    Set ws = ActiveSheet
    ws.Cells.EntireRow.Hidden = False
    maxrow = ws.Cells(rows.Count, "D").End(xlUp).Row
    Set dicROW = CreateObject("Scripting.Dictionary")
    Set dicPC = CreateObject("Scripting.Dictionary")
 
    For wrow = 10 To maxrow
        key = ws.Cells(wrow, "D").Value
        If key <> "" Then
            cellE = ws.Cells(wrow, "E").Value
            If dicROW.exists(key) = False Then
                dicROW(key) = wrow
                dicPC(key) = False
            Else
                dicROW(key) = dicROW(key) & "," & wrow
            End If
            If InStr(1, cellE, "PC", vbTextCompare) = 0 Then
                dicPC(key) = True
            End If
        End If
    Next
    For Each key In dicROW.keys
        If dicPC(key) = True Then
            elms = Split(dicROW(key), ",")
            If UBound(elms) >= 1 Then
                For i = 0 To UBound(elms)
                    ws.rows(elms(i)).Hidden = True
                Next
            End If
        End If
    Next
End Sub
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIOmdnuihqOekuigpCiAgICBEaW0gd3JvdyBBcyBMb25nCiAgICBEaW0gd3MgQXMgV29ya3NoZWV0CiAgICBEaW0gZGljUk9XIEFzIE9iamVjdAogICAgRGltIGRpY1BDIEFzIE9iamVjdAogICAgRGltIG1heHJvdyBBcyBMb25nCiAgICBEaW0ga2V5IEFzIFZhcmlhbnQKICAgIERpbSBjZWxsRSBBcyBTdHJpbmcKICAgIERpbSBlbG1zIEFzIFZhcmlhbnQKICAgIERpbSBpIEFzIExvbmcKICAgIFNldCB3cyA9IEFjdGl2ZVNoZWV0CiAgICB3cy5DZWxscy5FbnRpcmVSb3cuSGlkZGVuID0gRmFsc2UKICAgIG1heHJvdyA9IHdzLkNlbGxzKHJvd3MuQ291bnQsICJEIikuRW5kKHhsVXApLlJvdwogICAgU2V0IGRpY1JPVyA9IENyZWF0ZU9iamVjdCgiU2NyaXB0aW5nLkRpY3Rpb25hcnkiKQogICAgU2V0IGRpY1BDID0gQ3JlYXRlT2JqZWN0KCJTY3JpcHRpbmcuRGljdGlvbmFyeSIpCgogICAgRm9yIHdyb3cgPSAxMCBUbyBtYXhyb3cKICAgICAgICBrZXkgPSB3cy5DZWxscyh3cm93LCAiRCIpLlZhbHVlCiAgICAgICAgSWYga2V5IDw+ICIiIFRoZW4KICAgICAgICAgICAgY2VsbEUgPSB3cy5DZWxscyh3cm93LCAiRSIpLlZhbHVlCiAgICAgICAgICAgIElmIGRpY1JPVy5leGlzdHMoa2V5KSA9IEZhbHNlIFRoZW4KICAgICAgICAgICAgICAgIGRpY1JPVyhrZXkpID0gd3JvdwogICAgICAgICAgICAgICAgZGljUEMoa2V5KSA9IEZhbHNlCiAgICAgICAgICAgIEVsc2UKICAgICAgICAgICAgICAgIGRpY1JPVyhrZXkpID0gZGljUk9XKGtleSkgJiAiLCIgJiB3cm93CiAgICAgICAgICAgIEVuZCBJZgogICAgICAgICAgICBJZiBJblN0cigxLCBjZWxsRSwgIlBDIiwgdmJUZXh0Q29tcGFyZSkgPSAwIFRoZW4KICAgICAgICAgICAgICAgIGRpY1BDKGtleSkgPSBUcnVlCiAgICAgICAgICAgIEVuZCBJZgogICAgICAgIEVuZCBJZgogICAgTmV4dAogICAgRm9yIEVhY2gga2V5IEluIGRpY1JPVy5rZXlzCiAgICAgICAgSWYgZGljUEMoa2V5KSA9IFRydWUgVGhlbgogICAgICAgICAgICBlbG1zID0gU3BsaXQoZGljUk9XKGtleSksICIsIikKICAgICAgICAgICAgSWYgVUJvdW5kKGVsbXMpID49IDEgVGhlbgogICAgICAgICAgICAgICAgRm9yIGkgPSAwIFRvIFVCb3VuZChlbG1zKQogICAgICAgICAgICAgICAgICAgIHdzLnJvd3MoZWxtcyhpKSkuSGlkZGVuID0gVHJ1ZQogICAgICAgICAgICAgICAgTmV4dAogICAgICAgICAgICBFbmQgSWYKICAgICAgICBFbmQgSWYKICAgIE5leHQKRW5kIFN1Ygo=