'по формуле (4)

n = Cells(1, 5)

For i = 1 To n

Application.Cells(i + 2, 10) = Cells(i + 1, 1) / Cells(4, 4)

Next i

For i = 1 To n

Application.Cells(i + 2, 11) = Cells(i + 1, 2) / Cells(4, 5)

Next i

For i = 1 To n

Application.Cells(i + 2, 12) = Cells(i + 1, 3) / Cells(4, 6)

Next i

Cells(19, 4) = "Готово"

GoTo metka

End If

If OptionButton5.Value = True Then

'по формуле (6)формируем матрицу расстояний

Cells(19, 4) = "Ждите..."

n = Cells(1, 5)

For i = 1 To n

For j = 1 To n

Application.Cells(j + 2, 18 + i) = Abs(Cells(j + 2, 7) - Cells(i + 2, 7)) + Abs(Cells(j + 2, 8) - Cells(i + 2, 8)) + Abs(Cells(j + 2, 9) - Cells(i + 2, 9))

Next j

Next i

'по формуле (4)формируем матрицу расстояний

n = Cells(1, 5)

For i = 1 To n

For j = 1 To n

Application.Cells(j + 24, 18 + i) = Sqr((Cells(j + 2, 10) - Cells(i + 2, 10)) * (Cells(j + 2, 10) - Cells(i + 2, 10)) + (Cells(j + 2, 11) - Cells(i + 2, 11)) * (Cells(j + 2, 11) - Cells(i + 2, 11)) + (Cells(j + 2, 12) - Cells(i + 2, 12)) * (Cells(j + 2, 12) - Cells(i + 2, 12)))

Next j

Next i

Cells(19, 4) = "Готово"

GoTo metka

End If

If OptionButton6.Value = True Then

Cells(19, 4) = "Ждите..."

'Выделение классов разделением на две части

n = Cells(1, 5)

For i = 1 To n / 2

k(i) = 1

Application.Cells(26 + i, 3) = Application.Cells(1 + i, 1)

Application.Cells(26 + i, 4) = Application.Cells(1 + i, 2)

Application.Cells(26 + i, 5) = Application.Cells(1 + i, 3)

Application.Cells(26 + i, 1) = i

Next i

For i = n / 2 + 1 To n

k(i) = 2

Application.Cells(26 + i, 3) = Application.Cells(1 + i, 1)

Application.Cells(26 + i, 4) = Application.Cells(1 + i, 2)

Application.Cells(26 + i, 5) = Application.Cells(1 + i, 3)

Application.Cells(16 + i, 2) = i

Next i

'формируем класс 1

For l = 1 To n / 4

imin = 1

jmin = 2

min = 1000

For i = 1 To n

For j = 1 To n

If Application.Cells(2 + j, i + 18) < min Then

If i <> j Then

If (k(i) = 1) And (k(j) = 2) Then

imin = i

jmin = j

min = Application.Cells(2 + j, i + 18)

End If

End If

End If

Next j

Next i

k(jmin) = 1

Application.Cells(25 + l, 7) = jmin

Next l

'формируем класс 2

For l = 1 To n / 4

imin = 1

jmin = 2

min = 1000

For i = 1 To n

For j = 1 To n

If Application.Cells(2 + j, i + 18) < min Then

If i <> j Then

If (k(i) = 2) And (k(j) = 1) Then

imin = i

jmin = j

min = Application.Cells(2 + j, i + 18)

End If

End If

End If

Next j

Next i

k(jmin) = 2

Application.Cells(30 + l, 7) = jmin

Next l

'Вывод классов на рабочий лист

l = 1

For i = 1 To n

If k(i) = 1 Then

Application.Cells(26 + l, 13) = i

Application.Cells(26 + l, 15) = Application.Cells(1 + i, 1)

Application.Cells(26 + l, 16) = Application.Cells(1 + i, 2)

Application.Cells(26 + l, 17) = Application.Cells(1 + i, 3)

l = l + 1

End If

Next i

m = 1

For i = 1 To n

If k(i) = 2 Then

Application.Cells(26 + m, 14) = i

Application.Cells(36 + m, 15) = Application.Cells(1 + i, 1)

Application.Cells(36 + m, 16) = Application.Cells(1 + i, 2)

Application.Cells(36 + m, 17) = Application.Cells(1 + i, 3)

m = m + 1

End If

Next i

'Выделение классов по признаку четность

n = Cells(1, 5)

l = 1

For i = 1 To n

If i Mod 2 = 0 Then

k(i) = 1

Application.Cells(76 + l, 1) = i

Application.Cells(76 + l, 3) = Application.Cells(1 + i, 1)

Application.Cells(76 + l, 4) = Application.Cells(1 + i, 2)

Application.Cells(76 + l, 5) = Application.Cells(1 + i, 3)

l = l + 1

End If

Next i

l = 1

For i = 1 To n

If i Mod 2 <> 0 Then

k(i) = 2

Application.Cells(76 + l, 2) = i

Application.Cells(86 + l, 3) = Application.Cells(1 + i, 1)

Application.Cells(86 + l, 4) = Application.Cells(1 + i, 2)

Application.Cells(86 + l, 5) = Application.Cells(1 + i, 3)

l = l + 1

End If

Next i

'формируем класс 1 по признаку четность

For l = 1 To n / 4

imin = 1

jmin = 2

min = 1000

For i = 1 To n

For j = 1 To n

If Application.Cells(2 + j, i + 18) < min Then

If i <> j Then

If (k(i) = 1) And (k(j) = 2) Then

imin = i

jmin = j

min = Application.Cells(2 + j, i + 18)

End If

End If

End If

Next j

Next i

k(jmin) = 1

Application.Cells(75 + l, 7) = jmin

Next l

'формируем класс 2 по признаку четность

For l = 1 To n / 4

imin = 1

jmin = 2

min = 1000

For i = 1 To n

For j = 1 To n

If Application.Cells(2 + j, i + 18) < min Then

If i <> j Then

If (k(i) = 2) And (k(j) = 1) Then

imin = i

jmin = j

min = Application.Cells(2 + j, i + 18)

End If

End If

End If

Next j

Next i

k(jmin) = 2

Application.Cells(80 + l, 7) = jmin

Next l

'Вывод классов по признаку четность на рабочий лист

l = 1

For i = 1 To n

If k(i) = 1 Then

Application.Cells(76 + l, 13) = i

Application.Cells(76 + l, 15) = Application.Cells(1 + i, 1)

Application.Cells(76 + l, 16) = Application.Cells(1 + i, 2)

Application.Cells(76 + l, 17) = Application.Cells(1 + i, 3)

l = l + 1

End If

Next i

m = 1

For i = 1 To n

If k(i) = 2 Then

Application.Cells(76 + m, 14) = i

Application.Cells(86 + m, 15) = Application.Cells(1 + i, 1)

Application.Cells(86 + m, 16) = Application.Cells(1 + i, 2)

Application.Cells(86 + m, 17) = Application.Cells(1 + i, 3)

m = m + 1

End If

Next i

'Работа с матрицей по евклидовому расстоянию

n = Cells(1, 5)

For i = 1 To n / 2

k(i) = 1

Application.Cells(126 + i, 3) = Application.Cells(1 + i, 1)

Application.Cells(126 + i, 4) = Application.Cells(1 + i, 2)

Application.Cells(126 + i, 5) = Application.Cells(1 + i, 3)

Application.Cells(126 + i, 1) = i

Next i

For i = n / 2 + 1 To n

k(i) = 2

Application.Cells(126 + i, 3) = Application.Cells(1 + i, 1)

Application.Cells(126 + i, 4) = Application.Cells(1 + i, 2)

Application.Cells(126 + i, 5) = Application.Cells(1 + i, 3)

Application.Cells(116 + i, 2) = i

Next i

'формируем класс 1

For l = 1 To n / 4

imin = 1

jmin = 2

min = 1000

For i = 1 To n

For j = 1 To n

If Application.Cells(24 + j, i + 18) < min Then

If i <> j Then

If (k(i) = 1) And (k(j) = 2) Then

imin = i

jmin = j

min = Application.Cells(24 + j, i + 18)

End If

End If

End If

Next j

Next i

k(jmin) = 1

Application.Cells(125 + l, 7) = jmin

Next l

'формируем класс 2

For l = 1 To n / 4

imin = 1

jmin = 2

min = 1000

For i = 1 To n

For j = 1 To n

If Application.Cells(24 + j, i + 18) < min Then

If i <> j Then

If (k(i) = 2) And (k(j) = 1) Then

imin = i

jmin = j

min = Application.Cells(24 + j, i + 18)

End If

End If

End If

Next j

Next i

k(jmin) = 2

Application.Cells(130 + l, 7) = jmin

Next l

'Вывод классов на рабочий лист

l = 1

For i = 1 To n

If k(i) = 1 Then

Application.Cells(126 + l, 13) = i

Application.Cells(126 + l, 15) = Application.Cells(1 + i, 1)

Application.Cells(126 + l, 16) = Application.Cells(1 + i, 2)

Application.Cells(126 + l, 17) = Application.Cells(1 + i, 3)

l = l + 1

End If

Next i

m = 1

For i = 1 To n

If k(i) = 2 Then

Application.Cells(126 + m, 14) = i

Application.Cells(136 + m, 15) = Application.Cells(1 + i, 1)

Application.Cells(136 + m, 16) = Application.Cells(1 + i, 2)

Application.Cells(136 + m, 17) = Application.Cells(1 + i, 3)

m = m + 1

End If

Next i

n = Cells(1, 5)

l = 1

For i = 1 To n

If i Mod 2 = 0 Then

k(i) = 1

Application.Cells(176 + l, 1) = i

Application.Cells(176 + l, 3) = Application.Cells(1 + i, 1)

Application.Cells(176 + l, 4) = Application.Cells(1 + i, 2)

Application.Cells(176 + l, 5) = Application.Cells(1 + i, 3)

l = l + 1

End If

Next i

l = 1

For i = 1 To n

If i Mod 2 <> 0 Then

k(i) = 2

Application.Cells(176 + l, 2) = i

Application.Cells(186 + l, 3) = Application.Cells(1 + i, 1)

Application.Cells(186 + l, 4) = Application.Cells(1 + i, 2)

Application.Cells(186 + l, 5) = Application.Cells(1 + i, 3)

l = l + 1

End If

Next i

'формируем класс 1 по признаку четность

For l = 1 To n / 4

imin = 1

jmin = 2

min = 1000

For i = 1 To n

For j = 1 To n

If Application.Cells(26 + j, i + 1) < min Then

If i <> j Then

If (k(i) = 1) And (k(j) = 2) Then

imin = i

jmin = j

min = Application.Cells(26 + j, i + 1)

End If

End If

End If

Next j

Next i

k(jmin) = 1

Application.Cells(175 + l, 7) = jmin

Next l

'формируем класс 2 по признаку четность

Страницы: 1, 2, 3, 4, 5, 6, 7, 8