四组数据中选五个,VBA如何实现

香川群子 · 发表于 2012-11-13 21:17

未去除重复时有结果972个。
=3^4*3*4=972

去除重复后只有648个结果
=3^4*(3-1)*4=648

Sub test2()
tms = Timer
arr = Range("a1").CurrentRegion
m = UBound(arr): n = UBound(arr, 2)
ReDim brr(1 To m ^ n * (m - 1) * n, n + 1): k = 0
Dim i1%, i2%, i3%, i4%
For i1 = 1 To m
For i2 = 1 To m
For i3 = 1 To m
For i4 = 1 To m
For i5 = 1 To m
For j5 = 1 To n
If i5 = i1 And j5 = 1 Then GoTo Nxt
If i5 = i2 And j5 = 2 Then GoTo Nxt
If i5 = i3 And j5 = 3 Then GoTo Nxt
If i5 = i4 And j5 = 4 Then GoTo Nxt
k = k + 1
brr(k, 0) = arr(i1, 1) & "," & arr(i2, 2) & "," & arr(i3, 3) & "," & arr(i4, 4) & "," & arr(i5, j5)
brr(k, 1) = arr(i1, 1)
brr(k, 2) = arr(i2, 2)
brr(k, 3) = arr(i3, 3)
brr(k, 4) = arr(i4, 4)
brr(k, 5) = arr(i5, j5)
Nxt:
Next j5, i5, i4, i3, i2, i1
[a1].Offset(, n + 2).Resize(k, n + 2) = brr
MsgBox k & vbCr & Format(Timer - tms, "0.000s")
End Sub

复制代码

香川群子 · 发表于 2012-11-13 21:19

用【香川组合】的递归代码稍微修改了一下：

Dim sj, jg(), m%, n%, k
Sub 香川组合递归2()
tms = Timer
sj = [a1].CurrentRegion: m = UBound(sj): n = UBound(sj, 2): Amn = m ^ n * (m - 1) * n
If Amn > 65536 Then Exit Sub Else ReDim jg(Amn, n + 1): k = 0
Call dgMn("", 0)
[a1].Offset(, n + 2).CurrentRegion = "": [a1].Offset(, n + 2).Resize(Amn, n + 2) = jg
MsgBox k & vbCr & Format(Timer - tms, "0.000s")
End Sub
Sub dgMn(s$, t%)
If t = n Then
p = Split(s, ",")
l = 0
For i = 1 To m
For j = 1 To n
If i <> Val(p(j)) Then
For jj = 1 To n
jg(k + l, jj) = sj(p(jj), jj)
jg(k + l, 0) = jg(k + l, 0) & "," & jg(k + l, jj)
Next
jg(k + l, n + 1) = sj(i, j)
jg(k + l, 0) = Mid(jg(k + l, 0), 2) & "," & jg(k + l, n + 1)
l = l + 1
End If
Next
Next
k = k + l: Exit Sub
End If
For j = 1 To m
Call dgMn(s & "," & j, t + 1)
Next j
End Sub

复制代码

luoyin268 · 发表于 2012-11-13 21:34

怎么还有648组数据！我理论算了才324种啊！！！！

香川群子 · 发表于 2012-11-13 21:35

换一种递归代码……可是效率并没有提高，因为重复部分没有被有效利用。

Dim sj, jg(), m%, n%, k
Sub 香川组合递归4()
tms = Timer
sj = [a1].CurrentRegion: m = UBound(sj): n = UBound(sj, 2): Amn = m ^ n * (m - 1) * n
If Amn > 65536 Then Exit Sub Else ReDim jg(Amn, n + 1): k = 0
Call dgM("", 0)
[a1].Offset(, n + 2).CurrentRegion = "": [a1].Offset(, n + 2).Resize(Amn, n + 2) = jg
MsgBox k & vbCr & Format(Timer - tms, "0.000s")
End Sub
Sub dgM(s$, t%)
If t = n + 1 Then
p = Split(s, ",")
For j = 1 To n
jg(k, j) = sj(p(j), j)
jg(k, 0) = jg(k, 0) & "," & jg(k, j)
Next
q = Split(p(n + 1), ";")
jg(k, n + 1) = sj(q(0), q(1))
jg(k, 0) = Mid(jg(k, 0), 2) & "," & jg(k, n + 1)
k = k + 1
Exit Sub
End If
For i = 1 To m
If t = n Then
For j = 1 To n
If i <> Val(Split(s, ",")(j)) Then Call dgM(s & "," & i & ";" & j, t + 1)
Next
Else
Call dgM(s & "," & i, t + 1)
End If
Next
End Sub

复制代码

香川群子 · 发表于 2012-11-13 21:37

4种代码的附件。

luoyin268 · 发表于 2012-11-13 21:40

还有相同的，还在请老大改改！！！如表所示

香川群子 · 发表于 2012-11-13 21:43

luoyin268 发表于 2012-11-13 21:34
怎么还有648组数据！我理论算了才324种啊！！！！

楼主你这个错误结果就别提什么理论了吧。

正确的计算过程和结果，我已经在11楼写出来了。

现在，把你的计算过程贴出来，帮你挑挑错在哪里。

luoyin268 · 发表于 2012-11-13 21:47

还有相同的，如表，请老大再帮我改该！！

香川群子 · 发表于 2012-11-13 21:47

理论计算是：

=combin(3,1)*combin(3,1)*combin(3,1)*combin(3,1)*combin(3*4-4,1)
=3*3*3*3*(3-1)*4
=3^4*(3-1)*4
=81*8
=648

或者，如果m行n列，取n+1个值的组合时，通用计算公式：
=m^n*(m-1)*n

luoyin268 · 发表于 2012-11-13 21:50

每组数据，不能重复！如表

		自动登录	找回密码
密码			免费注册