Добрый день всем! Подскажите возможно ли в excel рандомно расставить буквы в слове? Подскажите пожалуйста формулу для этого. Например корова - оркова и т.д. Заранее спасибо за помощь!
Добрый день всем! Подскажите возможно ли в excel рандомно расставить буквы в слове? Подскажите пожалуйста формулу для этого. Например корова - оркова и т.д. Заранее спасибо за помощь!s0vit
Function Anagram(ByVal Word As String) As String Dim i&, n& Randomize For i = 1 To Len(Word) \ 2 n = Len(Word) * Rnd + 1 Anagram = Anagram & Mid$(Word, n, 1) Word = Left$(Word, n - 1) & Mid$(Word, n + 1) Next Anagram = Anagram & Word End Function
[/vba]
Добрый день! Например, так: (UDF) [vba]
Код
Function Anagram(ByVal Word As String) As String Dim i&, n& Randomize For i = 1 To Len(Word) \ 2 n = Len(Word) * Rnd + 1 Anagram = Anagram & Mid$(Word, n, 1) Word = Left$(Word, n - 1) & Mid$(Word, n + 1) Next Anagram = Anagram & Word End Function
Хочу заметить один момент. Это не совсем случайный разброс букв. Своим кодом ты половину букв из слова случайно выдёргиваешь, а оставшуюся половину добавляешь с конца. Это значит, что если применять функцию к строке "12345678", то во второй половине результата числа всегда будут идти по возрастающей. Что уже пусть и слабая, но закономерность.
Предлагаю подправить одну строку функции для "совсем случайного" разброса:
[vba]
Код
For i = 1 To Len(Word) - 1
[/vba]
KSV, привет, классное решение!
Хочу заметить один момент. Это не совсем случайный разброс букв. Своим кодом ты половину букв из слова случайно выдёргиваешь, а оставшуюся половину добавляешь с конца. Это значит, что если применять функцию к строке "12345678", то во второй половине результата числа всегда будут идти по возрастающей. Что уже пусть и слабая, но закономерность.
Предлагаю подправить одну строку функции для "совсем случайного" разброса:
Function Anagram_(ByVal Word As String) As String Dim i&, n& Randomize With New Collection For i = 1 To Len(Word) .Add Mid(Word, i, 1) Next For i = 1 To .Count n = Int(Rnd * .Count) + 1 Anagram_ = Anagram_ & .Item(n) .Remove (n) Next End With End Function
[/vba]
[vba]
Код
Function Anagram_(ByVal Word As String) As String Dim i&, n& Randomize With New Collection For i = 1 To Len(Word) .Add Mid(Word, i, 1) Next For i = 1 To .Count n = Int(Rnd * .Count) + 1 Anagram_ = Anagram_ & .Item(n) .Remove (n) Next End With End Function
Rioran, привет! Я сначала сделал именно так (Len-1), но потом решил, что не стоит тратить в 2 раза больше времени и ресурсов, т.к. после "выдергивания" букв оставшаяся часть будет уже и так псевдо-перемешанной.
На строке с числами, да, будет видно, что во второй половине они будут идти по возрастанию, но когда речь идет не о цифрах, а о буквах, то это уже не заметно Единственное, что я бы изменил, это добавил бы единичку, чтобы в словах с нечетным кол-вом букв, выдергивалось больше половины, а не меньше, как сейчас. [vba]
Код
For i = 1 To Len(Word) \ 2 + 1
[/vba] Но это только мое IMHO , а ТС может сделать, как захочет.
Rioran, привет! Я сначала сделал именно так (Len-1), но потом решил, что не стоит тратить в 2 раза больше времени и ресурсов, т.к. после "выдергивания" букв оставшаяся часть будет уже и так псевдо-перемешанной.
На строке с числами, да, будет видно, что во второй половине они будут идти по возрастанию, но когда речь идет не о цифрах, а о буквах, то это уже не заметно Единственное, что я бы изменил, это добавил бы единичку, чтобы в словах с нечетным кол-вом букв, выдергивалось больше половины, а не меньше, как сейчас. [vba]
Код
For i = 1 To Len(Word) \ 2 + 1
[/vba] Но это только мое IMHO , а ТС может сделать, как захочет.KSV
Private Function stirWrd(ByVal strW As String) Static buff As Byte, buff2 As Byte Dim arrLtr() As Byte
Randomize buff = Len(strW) If buff < 2 Then Exit Function arrLtr = StrConv(strW, vbFromUnicode) For i = 0 To buff - 1 buff2 = Int(buff * Rnd) stirWrd = arrLtr(i) arrLtr(i) = arrLtr(buff2) arrLtr(buff2) = stirWrd Next i stirWrd = "" For i = 0 To buff - 1 stirWrd = stirWrd & Chr(arrLtr(i)) Next i End Function
[/vba]
Я через байтовый массив [vba]
Код
Private Function stirWrd(ByVal strW As String) Static buff As Byte, buff2 As Byte Dim arrLtr() As Byte
Randomize buff = Len(strW) If buff < 2 Then Exit Function arrLtr = StrConv(strW, vbFromUnicode) For i = 0 To buff - 1 buff2 = Int(buff * Rnd) stirWrd = arrLtr(i) arrLtr(i) = arrLtr(buff2) arrLtr(buff2) = stirWrd Next i stirWrd = "" For i = 0 To buff - 1 stirWrd = stirWrd & Chr(arrLtr(i)) Next i End Function
Вариант Gustav'a вдохновил для создания такой функции. По ресурсам, возможно, не самое оптимальное решение - просто понравился принцип.
[vba]
Код
Public Function Mess$(StrX$) Dim ArrX, i& ReDim ArrX(Len(StrX) - 1) Randomize For i = 0 To UBound(ArrX): ArrX(i) = Rnd: Next i Do While Len(Mess) < Len(StrX) For i = 0 To UBound(ArrX) If Application.WorksheetFunction.Max(ArrX) = ArrX(i) Then Mess = Mess & Mid(StrX, i + 1, 1) ArrX(i) = 0 Exit For End If Next i Loop End Function
[/vba]
Вариант Gustav'a вдохновил для создания такой функции. По ресурсам, возможно, не самое оптимальное решение - просто понравился принцип.
[vba]
Код
Public Function Mess$(StrX$) Dim ArrX, i& ReDim ArrX(Len(StrX) - 1) Randomize For i = 0 To UBound(ArrX): ArrX(i) = Rnd: Next i Do While Len(Mess) < Len(StrX) For i = 0 To UBound(ArrX) If Application.WorksheetFunction.Max(ArrX) = ArrX(i) Then Mess = Mess & Mid(StrX, i + 1, 1) ArrX(i) = 0 Exit For End If Next i Loop End Function
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
