Sub FFF()

    Dim arr, arr2, arr3, arr4, arr5, arr6, arr7, i As Long, n As Long, lr As Long, lcol As Long, tt As String, col As New Collection, fl As Boolean, m As Range, r, r1, r2, r3 As Range, mm1 As Range, mmm1 As Range, mm2 As Range, mmm2 As Range, mm3 As Range, mmm3 As Range, rm2 As Range, rm3 As Range, cc As Range
    Set m = [A11]
    Set r = Range("E11:AL11")
    Set rr = r.Resize(16)
    Set r1 = r.Offset(1)
    Set r2 = r.Offset(5)
    Set r3 = r.Offset(7)
    Set rm2 = m.Offset(4, 3)
    Set rm3 = m.Offset(7, 3)
    Set mm1 = m.Offset(2, 2)
    Set mmm1 = mm1.Offset(, 2)
    
    Set wb = ThisWorkbook: Set wb2 = Workbooks("222.xlsx")
    lr = wb2.Sheets("2").Cells(Rows.Count, 1).End(xlUp).Row
    lcol = Cells(10, Columns.Count).End(xlToLeft).Column
    arr = wb2.Sheets(1).Range("A2:BQ" & lr)
    arr2 = wb.Sheets(1).Range(Cells(10, 5), Cells(20, lcol))
    arr3 = wb2.Sheets(1).Range("A2:BQ" & lr)

    ReDim arr4(1 To 1, 1 To UBound(arr2, 2) - LBound(arr2) + 1): K = 1
    For i = LBound(arr2) To UBound(arr2, 2) - LBound(arr2) + 1
        tt = ""
        Set col = Nothing
        For n = LBound(arr) To UBound(arr)
            If arr2(1, i) = arr(n, 20) And arr(n, 37) = m And arr3(n, 3) = mm1 Then
                On Error Resume Next
                col.Add arr(n, 1), CStr(arr(n, 1))
            End If
        Next n
        For n = 1 To col.Count
            tt = tt & ", " & col(n)
            Do While col(n) = col(n + 1) - 1 And n < col.Count
                fl = True: n = n + 1
                If n >= col.Count Then Exit Do
            Loop
            If fl Then tt = tt & "-" & col(n): fl = False
        Next n
        arr4(1, K) = Mid(tt, 3): K = K + 1
    Next i
    mmm1.Resize(1, UBound(arr4, 2) - LBound(arr4) + 1).NumberFormat = "0"
    mmm1.Resize(1, UBound(arr4, 2) - LBound(arr4) + 1) = arr4
'''
    For Each c In mmm1.Resize(1, UBound(arr4, 2) - LBound(arr4) + 1).Cells
           v = c.Value
           If IsEmpty(v) Then
              c.Interior.Color = xlNone
           ElseIf IsNumeric(v) Then
           
    With c.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 0
        .Gradient.ColorStops.Clear
    End With
    With c.Interior.Gradient.ColorStops.Add(0)
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149021881771294
    End With
    With c.Interior.Gradient.ColorStops.Add(1)
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.400006103701895
    End With
    
           Else
           
    With c.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 0
        .Gradient.ColorStops.Clear
    End With
    With c.Interior.Gradient.ColorStops.Add(0)
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149021881771294
    End With
    With c.Interior.Gradient.ColorStops.Add(1)
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.400006103701895
    End With
    
           End If
           
    Next
    
End Sub