Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
楼主: 香川群子

[分享] 组合算法以及结果输出

[复制链接]
发表于 2015-4-25 17:55 | 显示全部楼层
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
for循环组合算法,21选6组合,轻松赢你一秒,你那个垃圾【递归】和【Do循环】组合算法
还敢吹天下第一,回去慢慢耕田,
回复

使用道具 举报

发表于 2015-4-25 17:57 | 显示全部楼层
目前没有人超越你,是因为你坐井观天,自认天下第一,随便找几个出来都你快
回复

使用道具 举报

发表于 2015-5-2 21:40 | 显示全部楼层
好失望吧,精英论坛没有人对你那个垃圾组合感兴趣,已经顶过N次,还没有人来鸟你
回复

使用道具 举报

发表于 2015-5-3 06:14 来自手机 | 显示全部楼层
香川群子 发表于 2014-10-22 15:53
附件在此。

有趣的是,为了保证输出结果的字典顺序,

太利害了 谢谢分享
回复

使用道具 举报

发表于 2015-5-3 07:58 来自手机 | 显示全部楼层
''企业余额调节
Public Used() As Byte, Used1() As Byte, n As Long
Public arr(), arr1()
Public M As Integer
Public Count As Long

Sub OneToMany()
Dim Total As Double
Dim data()
If Form1.List1.ListIndex = -1 Then
    Form1.List1.Selected(0) = True
End If
Total = Val(Split(Form1.List1.Text, "~")(0))
    For i = 0 To Form1.List2.ListCount - 1
        ReDim Preserve data(i)
        data(i) = Val(Split(Form1.List2.List(i), "~")(0))
        Form1.List2.Selected(i) = False
    Next i

Erase Used
Count = 0
n = UBound(data)
ReDim Used(UBound(data))
Solve Total, data
'select used
If Count > 0 Then
    For i = 0 To UBound(data)
        
        If Used(i) = 1 Then
            Form1.List2.Selected(i) = True
        End If
    Next i
End If
End Sub

Sub Solve(ByVal Total As Double, ByRef data, Optional ByVal firstsolution As Boolean = True) 'Get the first( or all if the 3rd param is false) combintaions which has a sum as Total
    Dim Fit As Boolean, Result() As String, Temp As Double  'Defines
   
    Do
        Fit = False 'Initialize

        Do
            For i = 0 To n
                Used(i) = 1 - Used(i) 'Used or Not used.
                If Used(i) = 1 Then Exit For
            Next
            If i > n Then Exit Do ' Nothing was found
            Temp = 0
            For i = 0 To n
            If Used(i) = 1 Then Temp = Temp + data(i) 'Get the sum of used data
            Next
            If Abs(Temp - Total) < 0.01 Then 'be same
                Fit = True 'A solution has been found.
                Exit Do 'Quit a while.
            End If
        Loop
        If Fit Then 'Return the solution found just now.
            Count = Count + 1 'Solution count
            ReDim Preserve Result(1 To Count) 'Return the solution as an array.
            For i = 0 To n
                If Used(i) = 1 Then Result(Count) = Result(Count) & "+" & data(i) 'The expression of the solution.
            Next
            Result(Count) = "Solution" & Count & ":  " & Total & "=" & Mid(Result(Count), 2) 'message of solution
            'Debug.Print Result(Count) 'Output to immediate window.
            If firstsolution = True Then Exit Sub  'Need the first solution only.
        End If
    Loop While Fit
'MsgBox IIf(Count > 1, Count & " solutions have ", IIf(Count = 0, "No ", 1) & " solution has ") & " been found!!!" 'Three options of the result: 0,1 or many
End Sub


回复

使用道具 举报

发表于 2015-5-3 07:59 来自手机 | 显示全部楼层
转一个用组合试算金额合计的
回复

使用道具 举报

发表于 2015-5-3 11:14 | 显示全部楼层
zpy2 发表于 2015-5-3 07:59
转一个用组合试算金额合计的

附件呢?
回复

使用道具 举报

发表于 2015-9-18 12:44 | 显示全部楼层
有朝一日,我要压倒你
回复

使用道具 举报

 楼主| 发表于 2015-9-18 14:14 | 显示全部楼层
zpy2 发表于 2015-5-3 07:58
''企业余额调节
Public Used() As Byte, Used1() As Byte, n As Long
Public arr(), arr1()

你这个大概是组合凑数用吧?

1堆数字、金额中,找出n个数的组合总和符合指定目标值。

…………
看着代码一大堆,实际运行效率很低的。
回复

使用道具 举报

发表于 2016-9-6 08:52 | 显示全部楼层
太利害了 谢谢分享
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2019-12-14 12:34 , Processed in 0.062400 second(s), 5 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表