VBA-Excel/Как случайно выбрать слово из словаря?

Question

Допустим, у меня есть база данных слов в Sheet2; он идет от A1 до B200.

Мне нужно случайно выбрать одно из этих слов; и показать его в Sheet1.

Кроме того, мне нужно иметь пробел между каждой буквой слова.

Пример: случайно выбранное слово COLD; он должен выглядеть следующим образом:

A1: C

A3: O

A5: L

A7: D

Как я могу закодировать это?

Answer 1

Предполагая, что слова записываются в колонке А sheet2 вы можете сделать следующее (часть этого раствора происходит от here:

Sub randomWord() 
Dim rndWordRow As Integer 
Dim arr() As String 
Dim buff() As String 

'Select row between 1 and 200 randomly' 
rndWordRow = Int((200 - 1 + 1) * Rnd + 1) 

'Write text of the randomly selected row into variable' 
rndWord = Sheets("Sheet2").Cells(rndWordRow, 1) 

'Write letters of text into array' 
ReDim buff(Len(rndWord) - 1) 
For i = 1 To Len(rndWord) 
    buff(i - 1) = Mid$(rndWord, i, 1) 
Next 

'Loop through array and write letters in single cells' 
For i = 0 To UBound(buff) 
    Sheets("Sheet1").Cells(i + 1, 1) = buff(i) 
Next i 

End Sub 

Answer 2

попробовать этот код:

Option Explicit 

Sub main() 
    Dim word As String 

    word = GetRandomWord(Worksheets("Sheet2").Range("A1:B200")) '<--| get content of a random cell in passed range 
    Worksheets("Sheet1").Range("a1").Resize(2 * Len(word) - 1).Value = Application.Transpose(SeparatedChars(word)) '<--| write it down from given worksheet cell A1 down skipping every two cells 
End Sub 

Function SeparatedChars(strng As String) As Variant 
    Dim i As Long 

    ReDim chars(0 To Len(strng) - 1) As String '<--| size a 'String' array to the length of passed word 
    For i = 1 To Len(strng) 
     chars(i - 1) = Mid$(strng, i, 1) '<--| fill array elements with word single characters 
    Next 
    SeparatedChars = Split(Join(chars, " "), " ") '<--| return an array whose elements are those of the 'String' array and interposed spaces 
End Function 

Function GetRandomWord(rng As Range) As String 
    Randomize 
    GetRandomWord = rng.Cells(Int((rng.Count) * Rnd() + 1)).Text 
End Function 

Answer 3

---

Sub Test() 
    Dim x As Long 
    Dim aWord 
    With Worksheets("Sheet1") 
     For x = 1 To 15 
      aWord = getRandomWord 
      .Cells(1, x).Resize(UBound(aWord)).value = aWord 
     Next 

    End With 
End Sub 

Function getRandomWord() 
    Dim Source As Range 
    Dim result 
    Dim i As Integer 
    Set Source = Worksheets("Sheet2").Range("A1:B200") 

    i = Int((Rnd * Source.Cells.Count) + 1) 
    result = StrConv(Source.Cells(i).Text, vbUnicode) 
    result = Split(Left(result, Len(result) - 1), vbNullChar) 
    getRandomWord = Application.Transpose(result) 
End Function 

Answer 4

Вот простое решение вашей проблемы. Эта процедура дает вам пустую ячейку между двумя буквами с первой буквой в первой ячейке.

R1 = Int(Rnd() * 200) 
R2 = Int(Rnd() * 2) 

anyword = Sheet2.Cells(R1, R2) 
x = Len(anyword) 
n = -1: i = 1 
Do 
    n = n + 2 
    Sheet1.Cells(n, 1) = Mid(anyword, i, 1) 
    i = i + 1 

Loop Until n > x * 2