Шаг 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)
Для определения отклонения суммы стандартизированных рангов от среднего значения (di ) в ячейку I54 необходимо ввести формулу:
I54: =H54-СРЗНАЧ($H$54:$H$58),
Далее скопируйте ее на весь диапазон ячеек I54:I58. В ячейку J54 вводится формула: =I54^2
Результат расчетов представлен на рисунке:
Рисунок 1.58 – Расчет коэффициента конкордации
Далее для расчета коэффициента конкордации необходимо рассчитать показатель связанных рангов (Tj). Для упрощения расчетов рекомендуется под матрицей стандартизированных рангов создать блок вспомогательных ячеек, в котором предусмотреть строку для ввода значения повторяющегося объекта и строку с указанием количества повторений.
Рисунок 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). При нажатии кнопки будет выдан запрос на выделение области рабочего листа, куда необходимо поместить результаты расчетов.
Использование макросов и динамических моделей позволяет существенно ускорить процесс обработки данных, получаемых от экспертов и избежать случайных ошибок.