Excel精英培训网

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

[已解决]随机获取数据

[复制链接]
发表于 2016-9-9 14:42 | 显示全部楼层 |阅读模式
本帖最后由 xingguo 于 2016-9-9 14:43 编辑

随机从数据源获取4个不重复的数据,详见附件。
最佳答案
2016-9-9 17:07
试做排序法
Sub tt() '排序法
    Dim arr, tmpArr
    Dim str$, i%, n%, m%
    Application.ScreenUpdating = False
    tmpArr = Split([m2], ",")
    ReDim arr(1 To UBound(tmpArr) + 1, 1 To 2)
    For i = 0 To UBound(tmpArr)
        arr(i + 1, 1) = tmpArr(i)
        arr(i + 1, 2) = Rnd
    Next
    [k1].Resize(UBound(arr), 2) = arr
    [k1].Resize(UBound(arr), 2).Sort [l1], , , , , , 1
    For n = 2 To 6
        str = ""
        For m = 1 To 4
            str = str & Chr(10) & m & "." & Cells(n * 4 - 8 + m, 11)
        Next
        Cells(n, 3) = Mid(str, 2)
    Next
    Range("k:l").ClearContents
    Application.ScreenUpdating = ture
End Sub

abc.zip

7.95 KB, 下载次数: 9

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2016-9-9 15:32 | 显示全部楼层
本帖最后由 gufengaoyue 于 2016-9-9 15:55 编辑
  1. Sub XXX()
  2. Dim arr
  3. arr = Split([m2], ","):   Randomize
  4. For x = 0 To UBound(arr)
  5.    a = Int(Rnd * x):   T = arr(x):   arr(x) = arr(a): arr(a) = T
  6. Next
  7. For a = 2 To 6
  8. x = ""
  9.     For b = 1 To 4
  10.         x = x & vbCrLf & b & "." & arr((a - 2) * 4 + b - 1)
  11.     Next
  12.     Cells(a, 3) = Mid(x, 3)
  13. Next
  14. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
苏子龙 + 3 很给力,替换写的666,学习了

查看全部评分

回复

使用道具 举报

发表于 2016-9-9 17:07 | 显示全部楼层    本楼为最佳答案   
试做排序法
Sub tt() '排序法
    Dim arr, tmpArr
    Dim str$, i%, n%, m%
    Application.ScreenUpdating = False
    tmpArr = Split([m2], ",")
    ReDim arr(1 To UBound(tmpArr) + 1, 1 To 2)
    For i = 0 To UBound(tmpArr)
        arr(i + 1, 1) = tmpArr(i)
        arr(i + 1, 2) = Rnd
    Next
    [k1].Resize(UBound(arr), 2) = arr
    [k1].Resize(UBound(arr), 2).Sort [l1], , , , , , 1
    For n = 2 To 6
        str = ""
        For m = 1 To 4
            str = str & Chr(10) & m & "." & Cells(n * 4 - 8 + m, 11)
        Next
        Cells(n, 3) = Mid(str, 2)
    Next
    Range("k:l").ClearContents
    Application.ScreenUpdating = ture
End Sub

vba排序abc.zip

16.81 KB, 下载次数: 8

回复

使用道具 举报

 楼主| 发表于 2016-9-9 22:17 | 显示全部楼层
本帖最后由 xingguo 于 2016-9-9 22:19 编辑
gufengaoyue 发表于 2016-9-9 15:32

谢谢你的回答。再请问一下,位置改了一下,需要怎么修改。见附件。
还有数据源可以加到代码当中吗?

abcd.rar

11.27 KB, 下载次数: 7

回复

使用道具 举报

 楼主| 发表于 2016-9-12 10:41 | 显示全部楼层
苏子龙 发表于 2016-9-9 17:07
试做排序法
Sub tt() '排序法
    Dim arr, tmpArr

位置换了一下,需要怎么改
回复

使用道具 举报

发表于 2016-9-12 11:02 | 显示全部楼层
那改下位置就好了

abcd.zip

17.86 KB, 下载次数: 12

回复

使用道具 举报

 楼主| 发表于 2016-9-12 13:21 | 显示全部楼层
苏子龙 发表于 2016-9-12 11:02
那改下位置就好了

替换法的话,如果在数据源中加入"ZZ",并且ZZ在每天中都会出现,位置是1,2,3,4中的随机位置。能不能改
回复

使用道具 举报

发表于 2016-9-12 13:27 | 显示全部楼层
还是另外开帖吧,一会又变,什么时候能到头?
回复

使用道具 举报

 楼主| 发表于 2016-9-12 14:26 | 显示全部楼层
苏子龙 发表于 2016-9-12 13:27
还是另外开帖吧,一会又变,什么时候能到头?

我又发了个新帖子,有时间的话麻烦帮忙看一下。谢谢~
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 21:03 , Processed in 0.413807 second(s), 18 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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