比组合算法更难的【排列算法生成器】代码

shine2012

楼主，我运行你的代码，输入5和5，为什么出现错误

香川群子

shine2012 发表于 2014-11-13 17:18
楼主，我运行你的代码，输入5和5，为什么出现错误

看提示就能明白： 不是我的代码的问题，是你的VBE设置有问题。

必须允许能修改VBA模块的操作权限……自己去看一下相关设置吧。

shine2012

香川群子 发表于 2014-11-14 10:05
看提示就能明白： 不是我的代码的问题，是你的VBE设置有问题。

必须允许能修改VBA模块的操作权限……自 ...

我知道不是你代码的错误，我当时只是想我哪里出现错误了

qq348104184

大师的代码很牛啊，但感觉移植性较差，这是小生写的代码，请大师指点。
Dim x As Integer
Dim dicdata, colldata
Dim m As Integer
Sub a()
m = Cells(1, 2)
Dim n As Integer
Set colldata = New Collection
Set dicdata = CreateObject("Scripting.Dictionary")
For n = 1 To [A1].End(xlDown).Row
    colldata.Add Cells(n, 1)
Next
End Sub
Sub d()
Dim n&, i
Dim ncoll
For Each ncoll In colldata
    If Not dicdata.exists(ncoll) Then
        If dicdata.Count = m Then
            x = x + 1
            i = dicdata.keys
            For n = 0 To UBound(i)
               Cells(x, 8 + n) = i(n)
            Next
            Exit Sub
        ElseIf dicdata.Count < m Then
            dicdata(ncoll) = ""
            Call d
            dicdata.Remove ncoll
        End If
    End If
Next
End Sub
Sub ok()
Call a
Call d
End Sub

qq348104184

香川群子 发表于 2014-11-14 10:05
看提示就能明白： 不是我的代码的问题，是你的VBE设置有问题。

必须允许能修改VBA模块的操作权限……自 ...

请大师指点下上面代码

qq348104184

我写了排列组合的代码，请大师指点下 A列是数据 b1是要排列组合的数据
Dim x As Long '总行数
Dim dicdata, colldata
Dim m As Integer
Dim row_arr, col_arr, indata
Sub a()
ReDim indata(1 To [a1].End(xlDown).Row)
Dim n As Integer
Set colldata = New Collection
Set dicdata = CreateObject("Scripting.Dictionary")
For n = 1 To [a1].End(xlDown).Row
    colldata.Add "-" & Cells(n, 1)
    indata(n) = Range("A" & n)
Next
End Sub
Function h1(str)
    Dim n As Integer
    n = Len(str) - Len(Application.WorksheetFunction.Substitute(str, "-", ""))
    h1 = n
End Function
Function laststr(str)
    Dim STR1 As String
    Dim n As Integer, k&
    n = Len(str) - Len(Application.WorksheetFunction.Substitute(str, "-", ""))
    STR1 = Application.WorksheetFunction.Substitute(str, "-", "#", n)
    k = Application.WorksheetFunction.Find("#", STR1, 1)
    STR1 = Right(str, Len(str) - k)
    For n = 1 To [a1].End(xlDown).Row
        If STR1 = indata(n) Then laststr = n
    Next
End Function
Sub okk()
m = Cells(1, 2)
Call a
Dim n1&, n2&, n3&
Do
    If h1(colldata(1)) = m Then
        Exit Do
    ElseIf h1(colldata(1)) < m Then
       For n1 = laststr(colldata(1)) + 1 To [a1].End(xlDown).Row
            colldata.Add colldata(1) & "-" & indata(n1)
       Next
    End If
    colldata.Remove 1
Loop
For n3 = 1 To colldata.Count
    Range("D" & n3) = colldata(n3)
Next
End Sub

朕乃Excel小王子

谢谢分享，很受用

香川群子

qq348104184 发表于 2014-12-6 15:43
请大师指点下上面代码

你的代码就是把循环改成了递归结构，这样来简化代码量。【算法重复部分进入递归结构】

这个做法是好的。

但是，使用字典而不是用数组，这样执行效率很低。
使用集合而不是使用数组，效率也略低。


…………
其实，递归排列算法的代码，应该是这样子的：
（代码执行效率比你的字典方法快30倍。）

1. Dim sj, jl&(), jg(), k&, m&, n&
   
2. Sub 排列()
   
3.     m = [a1].End(4).Row: sj = [a1].Resize(m): n = [b1]
   
4.     k = WorksheetFunction.Permut(m, n)
   
5.     ReDim jg(1 To k, 1 To 1): ReDim jl&(1 To m)
   
6.    
   
7.     k = 0: Call dgPL("", 1)
   
8.    
   
9.     [d:d] = "": [d1].Resize(k) = jg
   
10. End Sub
    
11. Sub dgPL(s$, t&)
    
12.     Dim i&
    
13.     For i = 1 To m
    
14.         If jl(i) = 0 Then
    
15.             If t = n Then
    
16.                 k = k + 1 ': jg(k, 1) = s & sj(i, 1)
    
17.             Else
    
18.                 jl(i) = 1
    
19.                 Call dgPL(s & sj(i, 1), t + 1)
    
20.                 jl(i) = 0
    
21.             End If
    
22.         End If
    
23.     Next
    
24. End Sub

复制代码

wzb5566

占楼，学习，请称呼我为香粉

hjx00

香川老师您好！我是excel初学者，想请教你个问题。我想查找出工作表中低于一定字符数的单元格并清空这些单元格的内容，我在网上搜了好几天都没有找到这方面的代码，所以想麻烦您帮我写一个，最好是像您这个【排列算法生成器】一样可以按照需求输入字符数来筛选哦！因为我之前用过您的这个生成器代码，非常好用，所以我才厚颜相求的。我这个问题有发布帖子，您如果有空，麻烦您回复一下我。帖子链接：http://club.excelhome.net/forum. ... ead&tid=1329391