Код: (vb)

Function RndUnicArr(n&, Optional m& = 0)
'функция генерации случайных уникальных целых чисел от 1 до n
'возвращает горизонтальный массив из m элементов
    Dim i&, j&, a&()
    If n < 1 Or n > 10000000 Then Exit Function
    If m > n Or m < 1 Then m = n
    ReDim a&(1 To n)
    Randomize
    For i = 1 To n
        j = Int(Rnd * i + 1)
        If i <> j Then a(i) = a(j)
        a(j) = i
    Next i
    ReDim Preserve a&(1 To m)
    RndUnicArr = a
End Function

ivan-makeem1, Вы пошли каким то длинным путем, к тому же сотни даже не обработали
Возьмите готовую функцию "сумма прописью", которых достаточно много представлено в на форумах

Вот например моя "сумма прописью":

Код: (vb)

Function MSumProp$(chislo#) 'Автор MCH (Михаил Ч.), май 2012
Dim rub$, kop$, ed, des, sot, nadc, razr, i&, m$
If chislo >= 1E+15 Or chislo < 0 Then Exit Function

sot = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
des = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
nadc = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
ed = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ", "", "одна ", "две ")
razr = Array("триллион ", "триллиона ", "триллионов ", "миллиард ", "миллиарда ", "миллиардов ", "миллион ", "миллиона ", "миллионов ", "тысяча ", "тысячи ", "тысяч ", "рубль ", "рубля ", "рублей ")

rub = Left(Format(chislo, "000000000000000.00"), 15)
kop = Right(Format(chislo, "0.00"), 2)

If CDbl(rub) = 0 Then m = "ноль "
For i = 1 To Len(rub) Step 3
    If Mid(rub, i, 3) <> "000" Or i = Len(rub) - 2 Then
        m = m & sot(CInt(Mid(rub, i, 1))) & IIf(Mid(rub, i + 1, 1) = "1", nadc(CInt(Mid(rub, i + 2, 1))), _
                des(CInt(Mid(rub, i + 1, 1))) & ed(CInt(Mid(rub, i + 2, 1)) + IIf(i = Len(rub) - 5 And CInt(Mid(rub, i + 2, 1)) < 3, 10, 0))) & _
                IIf(Mid(rub, i + 1, 1) = "1" Or (Mid(rub, i + 2, 1) + 9) Mod 10 >= 4, razr(i + 1), IIf(Mid(rub, i + 2, 1) = "1", razr(i - 1), razr(i)))
    End If
Next i
MSumProp = UCase(Left(m, 1)) & Mid(m, 2) & kop & " копе" & IIf(kop \ 10 = 1 Or ((kop + 9) Mod 10) >= 4, "ек", IIf(kop Mod 10 = 1, "йка", "йки"))
End Function

Всего 20 строчек кода, работает до триллионов

У хозяина форума, также есть собственная функция в надстройке MyAddin:
http://www.excel-vba.ru/nadstrojka-myaddin/propis_summ_rus-chislo-ili-summa-propisyu/

Оригинально.....а не разжуешь плиз формулу? а то, что то я сматрю на нее, а она в голове не раскладывается....

Легче объяснить формулу
=ОСТАТ(СУММ(1-(E$2:E2=E$1:E1));2)
E$2:E2=E$1:E1 - сравниваем смещенные массивы на одну строчку на равенство
нужно посчитать кол-во изменений значений, т.е. сколько раз получится значение ЛОЖЬ
для того чтобы их посчитьать, вычитаем полученный массив из единицы, получим массив нулей и единиц, единицы будут там, где ранее стояла ЛОЖЬ, ИСТИНА - станет нулем
с помощью СУММ складываем все это
Для определения четности используем ОСТАТ(...;2)
Если число четное - остаток от деления на 2 будет единица - раскрашиваем, если число четное - 0 - не раскрашиваем

формула с =-1^... работает аналогично, только для определения четности используем возведение -1 в степень, формула на 2 знака короче чем с ОСТАТ

Данный вопрос обсуждался здесь:
http://www.excelworld.ru/forum/7-1632-20376-16-1339590773
начиная с 84 поста от ZORRO2005 Дата: Среда, 13.06.2012, 16:32 

беда какаято с УФ у меня в 2007 офисе, настроил сохранил файл, отправил на сайт, открываю - не правильно раскрашено. у всех так?
на всякий случай сохраню в 2003 - в нем подобных проблем нет.

Можно и условным форматированием сделать
Длина формулы - 29 знаков, сами считайте сколько нужно времени для ее ввода

Код:

Sub Task()
Dim A As String, B As String, bFlag As Boolean, i As Long, Result As Long, iAsc As Integer
A = InputBox("Ввод строки А:")
B = InputBox("Ввод строки B:")
For i = 1 To Len(A)
    bFlag = bFlag Or InStr(1, B, Mid(A, i, 1)) = 0 'если будет хоть одно невхождение то bFlag=True
    iAsc = Asc(Mid(A, i, 1)) 'результат вычисляем в первом же цикле
    If iAsc >= 65 And iAsc <= 122 Then Result = Result + iAsc
Next i
If bFlag Then 'если не все буквы строки А входят в строку В то считаем произведение
    Result = 1
    For i = 1 To Len(B)
        If IsNumeric(Mid(B, i, 1)) Then Result = Result * Val(Mid(B, i, 1))
    Next i
End If
MsgBox "Строка В: " & B & vbNewLine & "Строка А: " & A & vbNewLine & "Результат: " & Result
End Sub