Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2534|回复: 5

[已解决]随机抽取问题

[复制链接]
发表于 2016-3-15 09:37 | 显示全部楼层 |阅读模式
各位大侠好:
   问题要求:用VBA来完成
   将表1中A列班级去掉重复后,只保留一个,复制到表2中的A列中;然后,每个班级中随机抽取一个宿舍,放到表2中相应班级的后面。
最佳答案
2016-3-15 15:14
yangfx163 发表于 2016-3-15 15:00
怎么这试着这个不行呢,没有反应,上一个是可以的。

fsd3f3fg.gif

随机抽取宿舍2.rar (14.32 KB, 下载次数: 10)

随机抽取宿舍.rar

3.31 KB, 下载次数: 5

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2016-3-15 09:57 | 显示全部楼层
  1. Sub tt()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     arr = [a1].CurrentRegion
  4.     For i = 2 To UBound(arr)
  5.         d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 2)
  6.     Next
  7.     ReDim brr(1 To d.Count, 1 To 2)
  8.     For Each x In d.keys
  9.         n = n + 1
  10.         brr(n, 1) = x
  11.         xrr = Split(d(x), ",")      '各班对应的宿舍组成的数组
  12.         p = Int(Rnd * UBound(xrr) + 1)      '随机数
  13.         brr(n, 2) = xrr(p)
  14.     Next
  15.     Sheet2.[a2].Resize(n, 2) = brr
  16. End Sub
复制代码

随机抽取宿舍.rar

12.81 KB, 下载次数: 5

回复

使用道具 举报

发表于 2016-3-15 10:41 | 显示全部楼层
本帖最后由 爱疯 于 2016-3-15 10:52 编辑

Sub test()
    Dim A, B, dic, i%
    A = Sheets(1).Range("a1").CurrentRegion
    Set dic = CreateObject("scripting.dictionary")

    '1)创建字典
    For i = 2 To UBound(A)
        If Not dic.exists(A(i, 1)) Then Set dic(A(i, 1)) = CreateObject("scripting.dictionary")    '1级字典
        If Not dic(A(i, 1)).exists(A(i, 2)) Then dic(A(i, 1))(A(i, 2)) = A(i, 2)    '2级字典
    Next i

    '2)导出班级
    Sheets(2).Activate
    A = dic.keys
    Range("a2").Resize(dic.Count) = Application.Transpose(A)

    '3)随机宿舍
    For i = 0 To UBound(A)
        B = dic(A(i)).keys
        A(i) = B(UBound(B) * Rnd)
    Next i
    Range("b2").Resize(dic.Count) = Application.Transpose(A)
End Sub



也做了,就帖上


回复

使用道具 举报

 楼主| 发表于 2016-3-15 15:00 | 显示全部楼层
爱疯 发表于 2016-3-15 10:41
Sub test()
    Dim A, B, dic, i%
    A = Sheets(1).Range("a1").CurrentRegion

怎么这试着这个不行呢,没有反应,上一个是可以的。
回复

使用道具 举报

发表于 2016-3-15 15:14 | 显示全部楼层    本楼为最佳答案   
yangfx163 发表于 2016-3-15 15:00
怎么这试着这个不行呢,没有反应,上一个是可以的。

fsd3f3fg.gif

随机抽取宿舍2.rar (14.32 KB, 下载次数: 10)
回复

使用道具 举报

 楼主| 发表于 2016-3-16 14:02 | 显示全部楼层
grf1973 发表于 2016-3-15 09:57

谢谢你,你这个做的非常好。
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 19:53 , Processed in 1.076244 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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