Algorithm 变量个数待定的VBA置换

最近，我试图得到未知数量变量的排列。对于undetermined，我的意思是我的目标是创建一个输入框，供用户输入数字

从简单开始。最初我的目标是得到一个4位数的排列，每个位数有不同数量的变量，即第一位数只能是a、B、C、D；第二位数字是E，F；第三位数字为G、H等。代码如下：

Sub Permut()

Count = 1

For a = 1 To 4
For b = 1 To 2
For c = 1 To 2
For d = 1 To 2
For e = 1 To 2
'chr(97) is the alphabet "a"
Cells(Count, 1) = Chr(96 + a) & Chr(96 + Len(a) + b) & Chr(96 + Len(a) + Len(b) + c) & _
             Chr(96 + Len(a) + Len(b) + Len(c) + d) & Chr(96 + Len(a) + Len(b) + Len(c) + Len(d) + e)
Count = Count + 1
Next
Next
Next
Next
Next

End Sub

这将为您提供64种不同的组合，无需重复

只是想知道有没有一种方法可以概括这个过程，这样人们就可以选择总共多少个变量，以及每个数字中有多少个变量

---

谢谢。

这里有一个解决方案，您可以将每个字符（数字）的最小值作为一个字符串传递给Permut函数，最大字符也作为一个字符串传递。两个字符串的字符数应该相等，当然：

Function Permut(min, max)
    Dim str, nxt, count

    str = min
    count = 1

    Do While str < max
        Cells(count, 1) = str 
        count = count + 1

        nxt = ""
        For i = Len(str) To 1 Step -1
            If Mid(str, i, 1) < Mid(max, i, 1) Then
                nxt = ChrW(AscW(Mid(str, i, 1))+1) & nxt
                Exit For
            End If
            nxt = Mid(min, i, 1) & nxt
        Next
        str = Left(str, Len(str) - Len(nxt)) & nxt
    Loop
    Cells(count, 1) = str 
End Sub

该示例将在您的工作表上生成以下列表：

abc
abd
abe
abf
acc
acd
ace
acf
英国广播公司
bbd
bbe
bbf
密件抄送
bcd
bce
bcf

如何使用用户输入和按钮单击执行此操作 如果要调用此代码以响应事件（如单击按钮），并希望向其传递两个单元格的内容，用户将首先在其中输入最小值和最大值字符串，请执行以下步骤：

在工作表上放置ActiveX命令按钮（将其放置在D1中的某个位置，以便为其他内容留出空间）

双击它以生成空的click事件处理程序。如果不起作用，请转到“代码”窗口，从窗口顶部的下拉列表中选择按钮的名称，然后从下一个下拉列表中选择“单击”

按如下方式完成该事件处理程序的代码（我假设该按钮名为CommandButton1，但不更改生成的名称）：

代码：

此代码假设用户必须在单元格B1和C1中输入最小和最大数字/字符。A列当然是为代码的输出保留的

---

有关如何添加命令按钮并将代码附加到其单击事件的更完整说明，请阅读。

这里有一个解决方案，您可以将每个字符（数字）的最小值作为一个字符串传递给Permut函数，最大字符也作为一个字符串传递。两个字符串的字符数应该相等，当然：

Function Permut(min, max)
    Dim str, nxt, count

    str = min
    count = 1

    Do While str < max
        Cells(count, 1) = str 
        count = count + 1

        nxt = ""
        For i = Len(str) To 1 Step -1
            If Mid(str, i, 1) < Mid(max, i, 1) Then
                nxt = ChrW(AscW(Mid(str, i, 1))+1) & nxt
                Exit For
            End If
            nxt = Mid(min, i, 1) & nxt
        Next
        str = Left(str, Len(str) - Len(nxt)) & nxt
    Loop
    Cells(count, 1) = str 
End Sub

该示例将在您的工作表上生成以下列表：

abc
abd
abe
abf
acc
acd
ace
acf
英国广播公司
bbd
bbe
bbf
密件抄送
bcd
bce
bcf

如何使用用户输入和按钮单击执行此操作 如果要调用此代码以响应事件（如单击按钮），并希望向其传递两个单元格的内容，用户将首先在其中输入最小值和最大值字符串，请执行以下步骤：

在工作表上放置ActiveX命令按钮（将其放置在D1中的某个位置，以便为其他内容留出空间）

双击它以生成空的click事件处理程序。如果不起作用，请转到“代码”窗口，从窗口顶部的下拉列表中选择按钮的名称，然后从下一个下拉列表中选择“单击”

按如下方式完成该事件处理程序的代码（我假设该按钮名为CommandButton1，但不更改生成的名称）：

代码：

此代码假设用户必须在单元格B1和C1中输入最小和最大数字/字符。A列当然是为代码的输出保留的

---

有关如何添加命令按钮并将代码附加到其单击事件的更完整说明，请阅读。

以上trincot的答案

我尝试过运行代码，但做了一些修改，因为我不知道如何将设置值放入单元格（0,1）。它一直在说错误。但是如果我将起始点改为Cells（1,1），那么我将错过最后一次排列。因此，我只需添加一个额外的if语句，以使代码按我所希望的方式工作

Function Permut(min, max)
    Dim str, nxt, count

    str = min
    count = 1

    Do While str < max

        Cells(count, 1) = str
        count = count + 1

        nxt = ""
        For i = Len(str) To 1 Step -1

            If Mid(str, i, 1) < Mid(max, i, 1) Then

            'asc("a")=97; chr(97) ="a"
                nxt = Chr(AscW(Mid(str, i, 1)) + 1) & nxt
                Exit For
            End If
            nxt = Mid(min, i, 1) & nxt
        Next

        str = Left(str, Len(str) - Len(nxt)) & nxt

        If str = max Then

            Cells(count, 1) = str

        End If

    Loop

End Function

函数置换（最小值、最大值）
Dim str，nxt，计数
str=min
计数=1
当str

以上是trincot的回答

我尝试过运行代码，但做了一些修改，因为我不知道如何将设置值放入单元格（0,1）。它一直在说错误。但是如果我将起始点改为Cells（1,1），那么我将错过最后一次排列。因此，我只需添加一个额外的if语句，以使代码按我所希望的方式工作

Function Permut(min, max)
    Dim str, nxt, count

    str = min
    count = 1

    Do While str < max

        Cells(count, 1) = str
        count = count + 1

        nxt = ""
        For i = Len(str) To 1 Step -1

            If Mid(str, i, 1) < Mid(max, i, 1) Then

            'asc("a")=97; chr(97) ="a"
                nxt = Chr(AscW(Mid(str, i, 1)) + 1) & nxt
                Exit For
            End If
            nxt = Mid(min, i, 1) & nxt
        Next

        str = Left(str, Len(str) - Len(nxt)) & nxt

        If str = max Then

            Cells(count, 1) = str

        End If

    Loop

End Function

函数置换（最小值、最大值）
Dim str，nxt，计数
str=min
计数=1
当str

该代码是错误的：Len（a）将a转换为字符串，并计算其包含的字符数，该值始终为1。这适用于您的cod中所有出现的Len（）