Question

我需要编写一个vba代码，它会给我一个单词的所有字母组合并将其保存到文本文件中（此代码是可选的）。例如，“aBc”这个词会返回：

aBc
acB
Bac
Bca
caB
cBa

我确信这是一个简单的代码，但我似乎无法弄明白。

这是我到目前为止的代码。它不断给我重复，而不是所有的结果。

Sub Scramble()
Dim Rand1()
a = Len(Range("a2").Value)
ReDim Rand1(a)
T = 0
Randomize
For n = 1 To a
  Check1:
  Rand1(n) = Int((a * Rnd(100)) + 1)
  For F = 1 To T
    If Rand1(n) = Rand1(F) Then GoTo Check1:
  Next F
  T = T + 1   
Next n

For s = 2 To 20
  Range("d" & s).ClearContents
  n = 1
  Rand1(n) = Int((a * Rnd(100)) + 1)
    For n = 1 To a
      Range("d" & s).Value = Range("d" & s).Value & Mid(Range("a2").Value, Rand1(n), 1)
    Next n
Next s

End Sub

Answer 1

递归方法很自然。加扰例如"MATH"你一次拉出一个字母，争夺剩余的字母，然后将拉出的字母插入前面。使用memoization，如下所示：

'Assumes that all letters are distinct

Dim Memory As Object

Function Helper(s As String, Optional delim As String = ",") As String
    Dim i As Long, n As Long
    Dim t As String, c As String
    Dim A As Variant

    If Memory.exists(s) Then
        Helper = Memory(s)
        Exit Function
    End If

    'otherwise:
    'Check Basis Case:

    If Len(s) <= 1 Then
        Helper = s
    Else
        n = Len(s)
        ReDim A(1 To n)
        For i = 1 To n
            c = Mid(s, i, 1)
            t = Replace(s, c, "")
            A(i) = Helper(t, delim)
            A(i) = c & Replace(A(i), delim, delim & c)
        Next i
        Helper = Join(A, delim)
    End If

    'record before returning:

    Memory.Add s, Helper
End Function

Function Scramble(s As String, Optional delim As String = ",") As String
    Set Memory = CreateObject("Scripting.dictionary")
    Scramble = Helper(s, delim)
    Set Memory = Nothing
End Function

Sub Test()
    Dim s As String
    Dim i As Long, n As Long
    Dim A As Variant

    s = "MATH"
    A = Split(Scramble(s), ",")
    For i = 0 To UBound(A)
        Cells(i + 1, 1).Value = A(i)
    Next i
End Sub

运行后，A栏看起来像：

MATH
MAHT
MTAH
MTHA
MHAT
MHTA
AMTH
AMHT
ATMH
ATHM
AHMT
AHTM
TMAH
TMHA
TAMH
TAHM
THMA
THAM
HMAT
HMTA
HAMT
HATM
HTMA
HTAM

在VBA中随机化单词

1 个答案: