Шаг 3 Формирование матрицы стандартизированных рангов

Для расчета стандартизированных рангов в MS Excel, к сожалению, не существует встроенной функции, однако этот недостаток может быть преодолен в результате создания пользовательской функции (написания макроса). Для этого необходимо выполнить следующую последовательность действий:

 

- В разделе ВИД выберите пункт МАКРОСЫ,щелкнув пиктограмму

- Создайте новую пользовательскую функцию st_rang, реализующую расчет стандартизированных рангов:

 

Function St_rang(x As Variant, R_1 As Object, t As Boolean) As Double

'R_1 As Object, t As Boolean) As Double

'x - значение из массива (например, адрес ячейки памяти)

'R_1 - массив (анализируемая выборка)

't - 0 - сортировка по возрастающей; 1 - сортировка по убывающей

 

Dim mas1() As Double

Dim mas2() As Double

Dim tmas() As Double

 

num_elem = R_1.Count 'номер элемента

 

'создание массива для ранжирования рангов

'Dim mas1 As Variant

'mas1 = R_1.Value

ReDim mas2(num_elem)

ReDim mas1(num_elem)

ReDim tmas(num_elem)

 

'Формирование копии выходного массива

For i = 1 To num_elem

mas1(i) = R_1.Cells(i)

mas2(i) = i

Next i

'Ранжирование массива данных

Counter = 1 ' инициализация индикатора перестановок

While Counter = 1 ' анализ значения индикатора перестановок

Counter = 0

For i = 1 To num_elem - 1

If mas1(i) > mas1(i + 1) Then tp = mas1(i): mas1(i) = mas1(i + 1): mas1(i + 1) = tp: Counter = 1

Next i

Wend

'поиск связанных рангов

i = 1

While i < num_elem

If mas1(i) = mas1(i + 1) Then 'начало связки

K = i + 1

While mas1(i) = mas1(K)

K = K + 1

If K > num_elem Then GoTo nm

Wend

nm: aver_rank = (mas2(i) + mas2(K - 1)) / 2

For m = i To K - 1

mas2(m) = aver_rank

Next m

i = K - 1

End If

i = i + 1

Wend

 

'поиск ранга введенного элемента массива

For i = 1 To num_elem

If x = mas1(i) Then St_rang = mas2(i)

Next i

End Function

 

3. Сохраните документ как книгу MS Excel с поддержкой макросов (с расширением .xlsm).

 

4. Создайте таблицу с названием Матрица стандартизированных рангов

 

 

Рисунок 1.56 – Расчет стандартизированных рангов

 

В ячейку С54 необходимо ввести созданную пользовательскую функцию, имеющую следующий синтаксис: = st_rang (число; ссылка; порядок),

Аргументы «число», «ссылка» и «порядок» аналогичны аргументам функции РАНГ. Пример использования функции st_rang приведен на рисунке (см. ячейку С54). Далее эту формулу необходимо растянуть на весь диапазон ячеек данного столбца. Копируя данную формулу в первые ячейки соседних столбцов необходимо преобразовать абсолютные ссылки на диапазон в относительные с использованием функциональной кнопки F4. В результате получим:

Рисунок 1.57 – Матрица стандартизированных рангов

 

Далее для расчета коэффициента конкордации необходимо определить сумму стандартизированных рангов. Для решения этой задачи воспользуемся стандартными функциями MS Excel:

 

В ячейку Н54 необходимо ввести функцию =СУММ(C54:G54), указав ссылку на диапазон ячеек соответствующей строки. Далее введенную формулу следует растянуть на блок ячеек Н65:Н58, а в итоговую строку данного столбцы ввести формулу: =СУММ(H54:H58)

 

Для определения отклонения суммы стандартизированных рангов от среднего значения (d_i ) в ячейку I54 необходимо ввести формулу:

 

I54: =H54-СРЗНАЧ($H$54:$H$58),

 

Далее скопируйте ее на весь диапазон ячеек I54:I58. В ячейку J54 вводится формула: =I54^2

 

Результат расчетов представлен на рисунке:

 

Рисунок 1.58 – Расчет коэффициента конкордации

 

Далее для расчета коэффициента конкордации необходимо рассчитать показатель связанных рангов (T_j). Для упрощения расчетов рекомендуется под матрицей стандартизированных рангов создать блок вспомогательных ячеек, в котором предусмотреть строку для ввода значения повторяющегося объекта и строку с указанием количества повторений.

 

Рисунок 1.59 – Расчет показателя связанных рангов

 

В ячейку С65 необходимо ввести формулу расчета показателя связанных рангов: =(C62^3-C62)+(C64^3-C64), а затем скопировать ее на весь диапазон ячеек С65:G65. Для определения итогового значения необходимо воспользоваться функцией СУММ:

 

Н65: =СУММ(C65:G65)

 

Для расчета коэффициента конкордации и критерия согласия Пирсона необходимо в любые пустые ячейки рабочего ввести расчетные формулы, указав ссылки на ячейки с соответствующими показателями.

 

Альтернативный вариант расчета коэффициента конкордации и критерия согласия Пирсона предполагает использование следующего макроса:

 

Sub Concord_cof()

'Вычисление коэффициента конкордации

Dim s_1() As Double

Dim s_links() As Double

Dim ranks_mas() As Double

Dim mas1() As Double

Dim mas2() As Double

Dim tp As Double

Dim alfa As Double

 

Set input_data = Application.InputBox( _

Title:="Ввод матрицы исходных данных", _

prompt:="Выделите в матрице рангов блок ячеек, содержащий экспертные оценки (без заголовков).", _

Type:=8)

 

Set Input_alfa = Application.InputBox( _

Title:="Ввод уровня значимости", _

prompt:="Выделите ячейку, содержащую уровень значимости", _

Type:=8)

 

alfa = Input_alfa.Value

 

Set Output_data = Application.InputBox( _

prompt:="Выберите ячейку, с которой будут выводится результаты оценки согласованности мнений экспертов", _

Type:=8)

 

Num_row = input_data.Rows.Count 'Вычисление количества строк

Num_col = input_data.Columns.Count 'Вычисление количества столбцов

 

ReDim s_1(Num_row)

ReDim s_links(Num_col)

ReDim ranks_mas(1 To Num_row, 1 To Num_col)

ReDim mas1(Num_row)

ReDim mas2(Num_row)

 

'Вычисление матрицы рангов

For j = 1 To Num_col

For i = 1 To Num_row

mas1(i) = input_data.Columns(j).Cells(i)

s_1(i) = i: mas2(i) = i

Next i

'Сортировка столбца данных

Counter = 1 ' Инициализация индикатора перестановок

While Counter = 1 ' Анализ значения индикатора перестановок

Counter = 0

For i = 1 To Num_row - 1

If mas1(i) > mas1(i + 1) Then

tp = mas1(i): mas1(i) = mas1(i + 1): mas1(i + 1) = tp: Counter = 1

tpn = s_1(i): s_1(i) = s_1(i + 1): s_1(i + 1) = tpn

End If

Next i

Wend

 

'Столбец данных (его копия) отсортирована

'Поиск связок среди ранжированного массива и корректировака рангов

ind_links = 0

s_links(j) = 0

i = 1

While i < Num_row

If mas1(i) = mas1(i + 1) Then 'начало связки

ind_links = 1

K = i + 1

While mas1(i) = mas1(K)

K = K + 1

If K > Num_row Then GoTo nm

Wend

nm: aver_rank = (mas2(i) + mas2(K - 1)) / 2

For m = i To K - 1

mas2(m) = aver_rank

Next m

s_links(j) = s_links(j) + ((K - i) ^ 3 - (K - i))

i = K - 1

End If

i = i + 1

Wend

 

'Возобновление порядка следования рангов в

'соответствиии с оригинальным массивом

Counter = 1 ' Инициализация индикатора перестановок

While Counter = 1 ' Анализ значения индикатора перестановок

Counter = 0

For i = 1 To Num_row - 1

If s_1(i) > s_1(i + 1) Then

tp = mas2(i): mas2(i) = mas2(i + 1): mas2(i + 1) = tp: Counter = 1

tpn = s_1(i): s_1(i) = s_1(i + 1): s_1(i + 1) = tpn

End If

Next i

Wend

 

For i = 1 To Num_row

ranks_mas(i, j) = mas2(i)

Next i

Next j

 

Dim R_sum As Double 'Общая сумма

Dim L_sum As Double

Dim R_obj_sum As Double 'Сумма рангов одного объекта

R_sum = 0

L_sum = 0

 

For i = 1 To Num_row

R_obj_sum = 0

For j = 1 To Num_col

R_obj_sum = R_obj_sum + ranks_mas(i, j)

Next j

R_sum = R_sum + (R_obj_sum - Num_col * (Num_row + 1) / 2) ^ 2

Next i

 

For j = 1 To Num_col

L_sum = L_sum + s_links(j)

Next j

'Вычисление коэффициента конкордации

Dim W_koff As Double

Dim W_krit As Double

Dim W_krit1 As Double

Dim A As Double

Dim B As Double

 

B = (Num_row - 1) / 2 - 1 / Num_col

A = B * (Num_col - 1)

 

W_koff = 12 * R_sum / (Num_col ^ 2 * (Num_row ^ 3 - Num_row) - Num_col * L_sum)

W_krit = 1 - Application.WorksheetFunction.BetaInv(alfa, A, B) + _

36 / ((Num_col ^ 2) * (Num_row ^ 3 - Num_row))

W_krit1 = Application.WorksheetFunction.ChiInv(alfa, Num_row - 1) / _

(Num_col * (Num_row - 1))

 

X_kvadrat_r = 12 * R_sum / (Num_col * Num_row * (Num_row + 1) - L_sum / (Num_row - 1))

 

'Формирование и вывод результатов

 

Output_data.Offset(0, 0).Value = "РЕЗУЛЬТАТ ОЦЕНКИ СОГЛАСОВАННОСТИ МНЕНИЙ ЭКСПЕРТОВ: "

Output_data.Offset(1, 0).Value = "Коэффициент конкордации = " & W_koff

Output_data.Offset(2, 0).Value = "Расчетное значение Х2 = " & X_kvadrat_r

 

If W_koff > W_krit Then

Output_data.Offset(3, 0).Value = "Коэффициент конкордации ЗНАЧИМ"

Else

Output_data.Offset(3, 0).Value = "Коэффициент конкордации НЕ ЗНАЧИМ"

End If

 

End Sub

 

Для упрощения использования созданного макроса целесообразно создать и использовать кнопочную форму, выполнив следующую последовательность действий:

- нажать многофункциональную кнопку MS Office, выбрать Параметры MS Excel,

- поставить отметку около пункта «Показывать вкладку Разработчик на ленте»

 

 

Рисунок 1.60 – Активизация надстройки VBA

 

 

 

- в меню РАЗРАБОТЧИК выбрать инструмент Вставить,в появившемся диалоговом окне выбрать инструмент «кнопка»

 

 

- указать имя макроса, который должен выполняться при нажатии данной кнопки, щелкнуть ОК.

 

 

Рисунок 1.61 – Запуск макроса

 

- перед выполнением данного макроса необходимо в одну из ячеек рабочего листа внести уровень значимости (например, 0,05). При нажатии кнопки будет выдан запрос на выделение области рабочего листа, куда необходимо поместить результаты расчетов.

 

Использование макросов и динамических моделей позволяет существенно ускорить процесс обработки данных, получаемых от экспертов и избежать случайных ошибок.