VBA-Excel /如何从字典中随机选取一个单词?

可以说,我有一个Sheet2的单词数据库; 它从A1到B200。

我需要随机select其中一个词。 并在Sheet1中显示。

而且,我需要在单词的每个字母之间留有空格。

例如:随机select的单词是COLD; 它必须像这样出现:

A1:C

A3:O

A5:L

A7:D

我怎样才能编码?

试试这个代码:

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 

假设单词写在sheet2的A列中,你可以做以下的事情(这个解决scheme的一部分来自这里 :

 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 

在这里输入图像说明


 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 

这是你的问题的一个简单的解决scheme。 这个例程给你一个两个字母之间的空白单元格与第一个单元格中的第一个字母。

 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