Function Rearrange(St As String) As String
     Dim i As Integer, j As Integer, arr, Flag As Boolean, B As Integer
     arr = Split(Trim(St), ", ")
     B = UBound(arr)
     If B < 4 Then
       Rearrange = St
       Exit Function
     End If
     Randomize
     ReDim arr2(B)
     Do
       Flag = True
       'Создаём вспомогательный рандомный массив индексов элементов
       For i = 0 To B
         j = Int(Rnd * i)
         arr2(i) = arr2(j)
         arr2(j) = i
       Next i
       'Проверяем его на наличие "соседних" значений
       For i = 1 To B
         If Abs(arr2(i) - arr2(i - 1)) = 1 Then Flag = False
       Next
       'Повторяем, пока в индексном массиве не будет "соседних" значений
     Loop Until Flag
     Rearrange = arr(arr2(0))
     For i = 1 To B
       Rearrange = Rearrange & ", " & arr(arr2(i))
     Next
End Function