Option Base 1
Option Explicit
'Option Private Module
'====================================================================================================
Sub DJMC()
Dim rng As Range, aRes() As String
Dim c&, p1&, p2&, p3&, t!, tx$
Const G& = 8109667, Y& = 8711167, R& = 7039480

t = Timer
Set rng = Range("A2:O4")
ReDim aRes(rng.Rows.Count, rng.Columns.Count)
If UBound(aRes, 1) <> 3 Then MsgBox "Must be 3 Rows in Range!", vbCritical, "ERROR": Exit Sub

For c = 1 To rng.Columns.Count
    p1 = rng.Cells(1, c).DisplayFormat.Interior.Color
    p2 = rng.Cells(2, c).DisplayFormat.Interior.Color
    p3 = rng.Cells(3, c).DisplayFormat.Interior.Color

    tx = IIf(p1 = G Or p1 = R, "1", "") & " " & IIf(p2 = G Or p2 = R, "x", "") & " " & IIf(p3 = G Or p3 = R, "2", "") ' RG
    aRes(1, c) = WorksheetFunction.Trim(tx): tx = ""

    tx = IIf(p1 = G Or p1 = Y, "1", "") & " " & IIf(p2 = G Or p2 = Y, "x", "") & " " & IIf(p3 = G Or p3 = Y, "2", "") ' YG
    aRes(2, c) = WorksheetFunction.Trim(tx): tx = ""

    tx = IIf(p1 = Y Or p1 = R, "1", "") & " " & IIf(p2 = Y Or p2 = R, "x", "") & " " & IIf(p3 = Y Or p3 = R, "2", "") ' RY
    aRes(3, c) = WorksheetFunction.Trim(tx): tx = ""
Next c

Range("A11").Resize(UBound(aRes, 1), UBound(aRes, 2)).Value2 = aRes
MsgBox "DONE", vbInformation, Format$(Timer - t, "0.00 sec")
End Sub
'====================================================================================================
Function DJMC_func(v1&, v2&, v3&, iType&) As String
Dim tx$, iMin&, iMax&

iMin = WorksheetFunction.Min(v1, v2, v3)
iMax = WorksheetFunction.Max(v1, v2, v3)

If iType = 1 Then       ' MinMax(RG)
    tx = IIf(v1 = iMin Or v1 = iMax, "1", "") & " " & IIf(v2 = iMin Or v2 = iMax, "x", "") & " " & IIf(v3 = iMin Or v3 = iMax, "2", "")
ElseIf iType = 2 Then   ' AvMax(YG)
    tx = IIf(v1 <> iMin, "1", "") & " " & IIf(v2 <> iMin, "x", "") & " " & IIf(v3 <> iMin, "2", "")
ElseIf iType = 3 Then   ' MinAv(RY)
    tx = IIf(v1 <> iMax, "1", "") & " " & IIf(v2 <> iMax, "x", "") & " " & IIf(v3 <> iMax, "2", "")
Else
    Exit Function
End If

DJMC_func = WorksheetFunction.Trim(tx)
End Function
'====================================================================================================
'====================================================================================================

=ИНДЕКС($P$2:$P$4;ПОИСКПОЗ(МАКС(A$2:A$4);A$2:A$4;0))&" "&ИНДЕКС($P$2:$P$4;ПОИСКПОЗ(МИН(A$2:A$4);A$2:A$4;0))