=ЦЕЛОЕ((МАКС(B:B)-B2)/((МАКС(B:B)-МИН(B:B)+1)/4))+1

Sub Group4()
    Dim arr As Variant
    arr = Range("B2:B21")
    
    Dim crr As Variant
    ReDim crr(1 To UBound(arr, 1), 1 To 1)
    
    Dim i1 As Byte
    Dim i2 As Byte
    Dim i3 As Byte
    Dim i As Byte
    
    Dim brr As Variant
    ReDim brr(1 To 4)
    Dim dMin As Double
    dMin = arr(1, 1)
    
    For i1 = 2 To UBound(arr, 1) - 3
    For i2 = i1 + 1 To UBound(arr, 1) - 2
    For i3 = i2 + 1 To UBound(arr, 1) - 1
        brr(1) = arr(1, 1) - arr(i1, 1)
        brr(2) = arr(i1 + 1, 1) - arr(i2, 1)
        brr(3) = arr(i2 + 1, 1) - arr(i3, 1)
        brr(4) = arr(i3 + 1, 1) - arr(UBound(arr, 1), 1)
        If dMin > WorksheetFunction.StDev_S(brr) Then
            dMin = WorksheetFunction.StDev_S(brr)
            For i = 1 To i1
                crr(i, 1) = 1
            Next
            For i = i1 + 1 To i2
                crr(i, 1) = 2
            Next
            For i = i2 + 1 To i3
                crr(i, 1) = 3
            Next
            For i = i3 + 1 To UBound(arr, 1)
                crr(i, 1) = 4
            Next
        End If
    Next
    Next
    Next
    
    Range("C2").Resize(UBound(crr, 1)) = crr
End Sub