变量未确定的VBA排列

时间:2016-01-28 17:06:07

标签: algorithm vba

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

从简单开始。最初我的目标是获得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种不同的组合而无需重复。

只是想知道有没有办法概括这个过程,以便人们可以选择总数以及每个数字中的变量数量?

谢谢。

2 个答案:

答案 0 :(得分:0)

这是一个解决方案,您可以将 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

你会这样称呼:

Permut "abc", "bcf"

该示例将在您的工作表上生成此列表:

  

ABC
  ABD
  安倍晋三
  ABF
  ACC
  ACD
  王牌
  ACF
  BBC
  BBD
  BBE
  BBF
  BCC
  BCD
  BCE
  bcf

如何使用用户输入和按钮执行此操作单击

如果要调用此代码以响应某个事件(例如按钮单击),并希望将用户首先输入 min max 字符串,然后按照以下步骤操作:

  1. 在工作表上放置一个ActiveX命令按钮(将其放在 D1 中的某处以留出其他一些东西的空间)
  2. 双击它以生成空单击事件处理程序。如果这不起作用,请转到代码窗口并从窗口顶部的下拉列表中选择按钮的名称,然后从下一个下拉列表中选择单击
  3. 完成该事件处理程序的代码,如下所示(我假设按钮名为 CommandButton1 ,但不要更改生成的名称):
  4. 代码:

    Private Sub CommandButton1_Click()
        Permut Range("B1"), Range("C1")
    End Sub
    

    此代码假定用户必须在 B1 C1 min 和 max 数字/字符>。 A 列当然是为代码输出保留的。

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

答案 1 :(得分:0)

归功于上面的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