Функция определения одинаковых значений

[xHk]

Помогите решить вот такую задачу:

Код: Выделить всё

Function Check(a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer, a5 As Integer)


Нужно определить:
Сколько одинаковых значений имеется и их количество.

Условия:
Значения переменных варьируются от 2 до 12.
Значение 2 принимает вид любого рядом стоящего значения (от 3 до 12).
Значения считать одинаковыми только в том случае если они стоят рядом.

Примеры передачи значений и их вывод:
Запрос: check(2,3,3,4,5)
Ответ: три тройки
Запрос: check(7,3,7,4,4)
Ответ: две четверки
Запрос: check(9,2,3,10,10)
Ответ: две девятки; две тройки; две десятки

Вот что я придумал, помогите доработать

Код: Выделить всё

Function Check(a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer, a5 As Integer)
Dim a%, b%, c%, d%, b1%, b2%, b3%, b4%
a = 0: b = 0: c = 0: d = 0
b1 = 0: b2 = 0: b3 = 0: b4 = 0

' a,b,c,d - считаем сколько одинаковых значений
' b1,b2,b3,b4 - считаем какие значения одинаковые
    If a1 = a2 Then a = 2: b1 = a1
    If a1 = a3 Then If a < 2 Then a = 2: b1 = a1 Else a = a + 1
    If a1 = a4 Then If a < 2 Then a = 2: b1 = a1 Else a = a + 1
    If a1 = a5 Then If a < 2 Then a = 2: b1 = a1 Else a = a + 1
   
If a2 <> a1 Then
    If a2 = a3 Then b = 2: b2 = a2
    If a2 = a4 Then If b < 2 Then b = 2: b2 = a2 Else b = b + 1
    If a2 = a5 Then If b < 2 Then b = 2: b2 = a2 Else b = b + 1
End If
   
If a3 <> a1 And a3 <> a2 Then
    If a3 = a4 Then c = 2: b3 = a3
    If a3 = a5 Then If c < 2 Then c = 2: b3 = a3 Else c = c + 1
End If

If a4 <> a3 And a4 <> a2 And a4 <> a1 Then
    If a4 = a5 Then d = 2: b4 = a4
End If


[ACiD]

Запрос: check(2,3,3,4,5)
Ответ: три тройки

Почему ответ три тройки, а не две.[1штука]

Запрос: check(9,2,3,10,10)
Ответ: две девятки; две тройки; две десятки

По аналогии с твоими требованиями здесь должно быть: две десятки[1штука, а не 3]

[xHk]

Запрос: check(2,3,3,4,5)
Ответ: три тройки

Почему ответ три тройки, а не две.[1штука]

Запрос: check(9,2,3,10,10)
Ответ: две девятки; две тройки; две десятки

По аналогии с твоими требованиями здесь должно быть: две десятки[1штука, а не 3]

В первом правильно, потому как "2" может принимать любое значение от 3 до 12, т.е. оно одновременно является всеми значениями одновременно. И к примеру Запрос: check(3,3,2,4,4), должен выдать три "3" и три "4"
А вот во втором я ошибся, действительно две "10".

[ACiD]

я бы написал через массив:

Код: Выделить всё

Dim mas(6) As Integer
mas(1) = 9:mas(2) = 2:mas(3) = 3:mas(4) = 10:mas(5) = 10:mas(6) = 0
stroka = ""
member = mas(1)
n = 1: k = 1
For i = 2 To 6
If member = mas(i) Then
  k = k + 1
ElseIf (member <> mas(i) And n <> k) Then
  For j = n - 1 To 1 Step -1
   If mas(j) <> 2 Then Exit For
   n = j
  Next j
  For j = n + 1 To 5
   If mas(j) <> 2 Then Exit For
   n = j
  Next j
  If member <> 2 Then
   stroka = stroka & "(" & Str(k - n + 1) & ") " & Str(member)
  End If
  member = mas(i): n = i: k = i
Else
  member = mas(i): n = i: k = i
End If
Next i
'MsgBox stroka 'это собственно результат
End

[xHk]

ACiD, я понять не могу почему в массиве 6-ть значений, мне нужно обрабатывать только 5-ть

[ACiD]

Алгоритм был написан на скорую руку. 6-е значение, чтобы не делать лишних условий и проверок по достижению границы массива.