条件付き書式でも可能ですが、ややこしいのと、色が多いのでVBA にしました。 Option Explicit ' Sub Macro1()     Dim Dictionary As Object     Dim Area As Range     Dim Key As Variant     Dim Index As Long     Dim Color1 As Long     Dim Color2 As Long     Dim ColorA As Long '     Set Dictionary = CreateObject("Scripting.Dictionary")     Dictionary("White") = rgbWhite     Dictionary("Red") = rgbRed     Dictionary("Blue") = rgbBlue     Dictionary("Yellow") = rgbYellow     Dictionary("Green") = rgbGreen     Dictionary("Pink") = rgbPink     Dictionary("SkyBlue") = rgbSkyBlue     Dictionary("Purple") = rgbPurple     Dictionary("Lightgreen") = rgbLightGreen     Dictionary("Orange") = rgbOrange     Dictionary("Navyblue") = rgbNavyBlue     Set Area = Range("A3:N" & ActiveSheet.UsedRange.Rows.Count)     Application.ScreenUpdating = False '     For Index = 1 To Area.Count Step 7         Key = Area(Index + 3)         Color1 = Dictionary(Key)         Key = Area(Index + 4)         Color2 = Dictionary(Key) '         If Area(Index + 5) = "未" Then             ColorA = Color1         Else             ColorA = Color2         End If '         If Area(Index + 5) > "" Then             Area(Index).Resize(, 6).Interior.Color = ColorA             Area(Index + 3).Interior.Color = Color1             Area(Index + 4).Interior.Color = Color2         End If     Next Index End Sub