查看: 454|回复: 13
各位老师，能否帮助编制一个有条件随机分组的程序，谢谢！
阅读权限10
在线时间 小时
问题描述：7个部门（a，b，c，d，e，f，g），每个部门9个人（a1，a2，……，a9；b1，b2，……，b9；g1，g2，……，g9）
要求：将63个人随机分成9组，每组7人，每组中每个部门各有一人，且同一人不能在不同组中出现
过分要求：能设置某几个人不能被分在同一组
谢谢各位老师！
阅读权限10
在线时间 小时
谢谢“chxw68”老师！
阅读权限95
在线时间 小时
Sub test()
&&Dim d(1 To 7) As New Dictionary
&&Dim r%, i%, c%, j5
&&Dim arr, brr
&&With Worksheets(&sheet1&)
& & arr = .Range(&a2:g10&)
& & ReDim brr(1 To 9, 1 To 7)
& & For j = 1 To 7
& && &For i = 1 To 9
& && &&&d(j)(i) = &&
& && &Next
& & Next
& & For j = 1 To UBound(brr, 2)
& && &For i = 1 To UBound(brr)
& && &&&kk = d(j).Keys
& && &&&m = Int(Rnd() * d(j).Count)
& && &&&brr(i, j) = arr(kk(m), j)
& && &&&d(j).Remove (kk(m))
& && &Next
& & Next
& & .Range(&i2&).Resize(UBound(brr), UBound(brr, 2)) = brr
&&End With
End Sub
复制代码
阅读权限95
在线时间 小时
详见附件。
15:03 上传
点击文件名下载附件
8.74 KB, 下载次数: 22
阅读权限95
在线时间 小时
我怎么感觉这个问题非常容易。
7次发9张牌，当然简单...&
阅读权限95
在线时间 小时
本帖最后由 香川群子 于
17:25 编辑
最后一个排除某些人在一起的组合的要求，
我把代码部分完成了，运行数次以后，发现似乎实际情况也没有那么容易出现禁止组合的。Sub test()
& & tms = Timer
& &
& & ar = [b2].Resize(9, 7)
& & Set d = CreateObject(&Scripting.Dictionary&)
& & For j = 1 To 7
& && &&&For i = 1 To 9
& && && && &d(ar(i, j)) = i
& && &&&Next
& & Next
& &
& & m = [a12].End(4).Row - 13
& & br = [b14].Resize(m, 7)
& & ReDim br1&(1 To m, 0 To 7)
& & For i = 1 To m
& && &&&k = 0
& && &&&For j = 1 To 7
& && && && &If br(i, j) && && Then k = k + 1: br1(i, j) = d(br(i, j))
& && &&&Next
& && &&&br1(i, 0) = k
& & Next
& &
& & Dim cr&(1 To 9, 1 To 7)
& & Dim dr(1 To 9, 1 To 7)
Redo:
& & Erase cr, dr
& & Randomize
& & For i = 1 To 9
& && &&&For j = 1 To 7
& && && && &Do
& && && && && & r = Int(Rnd * 9 + 1)
& && && && && & If cr(r, j) = 0 Then dr(i, j) = r: Exit Do
& && && && && & cnt1 = cnt1 + 1
& && && && &Loop
& && &&&Next
'& && &&&If dr(i, 1) = 1 Then Stop
& && &&&For k = 1 To m
& && && && &If br1(k, 0) & 1 Then
& && && && && & s = 0
& && && && && & For j = 1 To 7
& && && && && && &&&If dr(i, j) = br1(k, j) Then s = s + 1
& && && && && & Next
& && && && && & If s = br1(k, 0) Then Exit For
& && && && &End If
& && &&&Next
& && &&&If k & m Then
& && && && &For j = 1 To 7
& && && && && & r = dr(i, j)
& && && && && & cr(r, j) = 1
& && && && && & dr(i, j) = ar(r, j)
& && && && &Next
& && &&&Else
& && && && &cnt = cnt + 1
& && && && &If cnt & 200 Then cnt2 = cnt2 + cnt: cnt = 0: GoTo Redo
& && && && &i = i - 1
& && &&&End If
& & Next
& &
& & [l2].Resize(9, 7) = dr
& & MsgBox Format(Timer - tms, &0.000s &) & cnt1 & &/& & cnt2 + cnt
End Sub
复制代码
(12.05 KB, 下载次数: 9)
17:25 上传
点击文件名下载附件
阅读权限95
在线时间 小时
禁止组合要求如下：
① 必须2个人以上 (只有1个人无法排除)
② 仅排除禁止组合中n人全部出现的情况。
& & 如果需要排除禁止组合中每个人之间的二二组合，则需单独列出。
禁止 a1、b2、c3 仅排除 a1、b2、c3 同时出现的情形
如果需要排除 a1、b2 或 a1、c3 这样的组合，则需要单独列出，
而不能把禁止a1、b2、c3看做是同时排除这3个人中任意2个以上组合出现的情形。
阅读权限90
在线时间 小时
香川群子 发表于
禁止组合要求如下：
第三十一句代码：r = Int(Rnd * 9 + 1)
中的 9 是什么意思？
阅读权限10
在线时间 小时
谢谢“香川群子”老师！
阅读权限10
在线时间 小时
谢谢各位老师的辛勤劳动！
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 1151|回复: 8
你好，之个应用程序能不能帮我看一下
阅读权限20
在线时间 小时
& & & & & & & &
(12.27 KB, 下载次数: 22)
14:22 上传
点击文件名下载附件
我这个程序是发票查询软件，现在只能查江苏的。我需要改成重庆国税的。重庆的发票代码是。发票号码就是8位，还有增值税查询代码是发票号码就是8位，高手们能改吗？
阅读权限20
在线时间 小时
我想，这里应该还没有人会修改程序，做软件。
阅读权限95
在线时间 小时
你那个发票代码是可以输入的嘛，你要改成什么？
阅读权限95
在线时间 小时
(12.27 KB, 下载次数: 18)
14:44 上传
点击文件名下载附件
阅读权限100
在线时间 小时
& & & & & & & &
这里是VBA论坛，你发的那个是VBA吗？
阅读权限20
在线时间 小时
jlhao 发表于
老大，还是不行啊，里面连接的网址不是重庆国税的。还是一样查不了。
阅读权限20
在线时间 小时
jlhao 发表于
你那个发票代码是可以输入的嘛，你要改成什么？
现在这个只能查江苏的我要改成查重庆的。程序里面好像是有网址认定查江苏，我就是要改成查重庆的。里面的连接没有改动，那个发票代码改了也查不了的。
阅读权限95
在线时间 小时
ssjedx 发表于
现在这个只能查江苏的我要改成查重庆的。程序里面好像是有网址认定查江苏，我就是要改成查重庆的。里面的 ...
那你得说清江苏的网址是什么，重庆的又是什么
阅读权限20
在线时间 小时
jlhao 发表于
那你得说清江苏的网址是什么，重庆的又是什么
你好重庆的网址是http://218.70.65.68:7009/fpcx/
江苏的是http://218.4.190.21:7001/tax/fpzwcx_list.do
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 3189|回复: 6
阅读权限2UID520283函数0 关最后登录经验153 点在线时间43 小时VBA0 关分享记录好友技巧0 关相册主题段位0 段金币244 个积分158精华0帖子日志注册时间
幼儿园中班, 积分 158, 距离下一级还需 42 积分
金币244 个积分158帖子
(10.4 KB, 下载次数: 102)
21:32 上传
点击文件名下载附件
请老师帮忙编一段窗体录入时候的逐步提示信息的代码。要能拷贝到其他文件用的。谢谢！新年快乐！
阅读权限16UID342574函数0 关最后登录经验5365 点在线时间491 小时VBA0 关分享记录好友技巧0 关相册主题段位1 段金币3084 个积分5370精华0帖子日志注册时间
金币3084 个积分5370帖子
happym8888发布于
本帖最后由 happym8888 于
08:05 编辑
Private Sub ComboBox1_Change()
Dim MyName()
n = Range(&A65536&).End(xlUp).Row
MyName = Worksheets(&Sheet1&).Range(&A1:A& & n).Value
If Len(ComboBox1.Text) &= 3 Then
For i = 1 To n
If MyName(i, 1) Like &*& & ComboBox1.Text & &*& = True Then ComboBox1.AddItem MyName(i, 1)
Next i
<boBox1.DropDown
End If
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox1.Clear
End Sub
复制代码何时清除下拉列表请楼主自己修改代码
阅读权限16UID342574函数0 关最后登录经验5365 点在线时间491 小时VBA0 关分享记录好友技巧0 关相册主题段位1 段金币3084 个积分5370精华0帖子日志注册时间
大学1年级, 积分 5370, 距离下一级还需 630 积分
金币3084 个积分5370帖子
&&&本楼为最佳答案&&&
本帖最后由 happym8888 于
08:05 编辑
Private Sub ComboBox1_Change()
Dim MyName()
n = Range(&A65536&).End(xlUp).Row
MyName = Worksheets(&Sheet1&).Range(&A1:A& & n).Value
If Len(ComboBox1.Text) &= 3 Then
For i = 1 To n
If MyName(i, 1) Like &*& & ComboBox1.Text & &*& = True Then ComboBox1.AddItem MyName(i, 1)
Next i
<boBox1.DropDown
End If
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox1.Clear
End Sub
复制代码何时清除下拉列表请楼主自己修改代码
08:02 上传
点击文件名下载附件
13.61 KB, 下载次数: 448
【综合1.A06】
【图表初级201201班】B07
【VBA学习小组】C17
【函快5班】H09
【新手8班】B59
阅读权限2UID520283函数0 关最后登录经验153 点在线时间43 小时VBA0 关分享记录好友技巧0 关相册主题段位0 段金币244 个积分158精华0帖子日志注册时间
幼儿园中班, 积分 158, 距离下一级还需 42 积分
金币244 个积分158帖子
本帖最后由 蒋德宏 于
12:13 编辑
happym8888 发表于
何时清除下拉列表请楼主自己修改代码
老师谢谢您 帮助我，谢谢！新年快乐
阅读权限2UID520283函数0 关最后登录经验153 点在线时间43 小时VBA0 关分享记录好友技巧0 关相册主题段位0 段金币244 个积分158精华0帖子日志注册时间
幼儿园中班, 积分 158, 距离下一级还需 42 积分
金币244 个积分158帖子
happym8888 发表于
何时清除下拉列表请楼主自己修改代码
老师 您能不能帮我在优化一下，每次我输入1101几的时候都是11013在最前面提示，其实我是想输入11014，我就是想当我输入11014的时候11014就在最前面提示 ，也就是当我输入什么的的时候就是什么在最前面。谢谢！
阅读权限16UID342574函数0 关最后登录经验5365 点在线时间491 小时VBA0 关分享记录好友技巧0 关相册主题段位1 段金币3084 个积分5370精华0帖子日志注册时间
大学1年级, 积分 5370, 距离下一级还需 630 积分
金币3084 个积分5370帖子
本帖最后由 happym8888 于
16:48 编辑
蒋德宏 发表于
老师 您能不能帮我在优化一下，每次我输入1101几的时候都是11013在最前面提示，其实我是想输入11014，我就 ...
你这个要求有点无理,当你输入1101几的时候电脑不知道你后面要输入11013还是11014,要么你把A列里面的11013删了.
【综合1.A06】
【图表初级201201班】B07
【VBA学习小组】C17
【函快5班】H09
【新手8班】B59
阅读权限4UID515058函数0 关最后登录经验364 点在线时间60 小时VBA0 关分享记录好友技巧0 关相册主题段位0 段金币268 个积分364精华0帖子日志注册时间
小学1年级, 积分 364, 距离下一级还需 236 积分
金币268 个积分364帖子
学习一下，有帮助
阅读权限4UID515058函数0 关最后登录经验364 点在线时间60 小时VBA0 关分享记录好友技巧0 关相册主题段位0 段金币268 个积分364精华0帖子日志注册时间
小学1年级, 积分 364, 距离下一级还需 236 积分
金币268 个积分364帖子
学习一下，有帮助
站长推荐 /1
由兰色幻想+小妖录制，全套290集excel高清视频，包括108集技巧，98个常用函数、80集VBA宏编程等内容，你想学的这里都有。全套视频限时5折优惠！
Powered by你好，可以给我发一个破解EXCEL vba密码的程序吗？谢谢 _百度知道
你好，可以给我发一个破解EXCEL vba密码的程序吗？谢谢
提问者采纳
原理其实就是利用了Office，里面有破解的代码，Excel密码算法的一个漏洞，然后把记事本里的代码复制到里面。用法，就OK了：直接打开Excel文件，调用VBA编辑器我发给你一个记事本文件，如有问题我们HI联系，然后运行这个宏：）希望对你有帮助，插入模块
不行啊 excel文件没有打开密码 我怎么调出VBA编辑器？ 现在我有网上的Office Password Recovery 恢复软件 怎么老是提示如图
？？？？？？？？？？？
先把Excel打开,然后按Alt+F11,就把VBA编辑器打开了.
我没有excel的打 开密码
我明白你的意思了，又给你发了个东西，破解速度非常快，但得需要网络联接：）
提问者评价
虽然 没成功但是 还是很感谢你的 谢谢
其他类似问题
为您推荐：
excel的相关知识
其他2条回答
已发送，这个我一直也在用。ytchun
直接用VBA破解嘛
等待您来回答
下载知道APP
随时随地咨询
出门在外也不愁你好！能否把VBA的计算器代码发给我 同时如何设置界面 谢谢 我的邮箱_百度知道
你好！能否把VBA的计算器代码发给我 同时如何设置界面 谢谢 我的邮箱
提问者采纳
已发送，请查收，谢谢
提问者评价
谢谢高手指点，非常满意。你太有才了
来自：求助得到的回答
来自团队：
其他类似问题
为您推荐：
vba的相关知识
等待您来回答
下载知道APP
随时随地咨询
出门在外也不愁