[已解决]随机抽取怎么都是一样的？

张雄友

Private Sub CommandButton1_Click() '随机抽取5个，怎么都是生成5个一样的？？？而且插入时要很长时间。
    Dim MyPath$, m&, n&, mf&, arrf$(), v&, Fso As Object, ar(1 To 54)
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show = False Then Exit Sub
    MyPath = .SelectedItems(1) & "\"
    End With
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Folder = Fso.GetFolder(MyPath)
    Call GetFiles(MyPath, sFileType, Fso, arrf, mf)
    For v = 1 To mf
        Randomize
        For i = 1 To 5 '随机抽取5个
            n = Rnd * (54 - i) + 1
            m = IIf(ar(n) > 0, ar(n), n)
            ar(n) = IIf(ar(55 - i) > 0, ar(55 - i), 55 - i)
            Me.OLEObjects("image" & i).Object.Picture = LoadPicture(arrf(1, v))
        Next
    Next
End Sub

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-5-31 21:30

我只上传表格附件，图片附件就不上传了！

跳转到最佳答案楼层

张雄友

好不容易找台电脑上传附件，恳请帮助。

老司机带带我

代码修改了一下，你看下：

1. Private Sub CommandButton1_Click() '随机抽取5个，怎么都是生成5个一样的？？？而且插入时要很长时间。
   
2.     Dim MyPath$, m&, n&, mf&, arrf$(), v&, Fso As Object, ar(1 To 54)
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.         .InitialFileName = ThisWorkbook.Path & ""
   
5.         If .Show = False Then Exit Sub
   
6.     MyPath = .SelectedItems(1) & ""
   
7.     End With
   
8.     Application.ScreenUpdating = False
   
9.     Application.DisplayAlerts = False
   
10.    
    
11.     Set Fso = CreateObject("Scripting.FileSystemObject")
    
12.     Set Folder = Fso.GetFolder(MyPath)
    
13.     Call GetFiles(MyPath, sFileType, Fso, arrf, mf)
    
14.     For v = 1 To mf
    
15.         Randomize
    
16.         For i = 1 To 5 '随机抽取5个
    
17.             n = Rnd * (21 - i) + 1  '21为新建文件夹1中的图片个数，如果选择新建文件夹需要重新设置
    
18.             m = IIf(ar(n) > 0, ar(n), n)
    
19.             ar(n) = IIf(ar(55 - i) > 0, ar(55 - i), 55 - i)
    
20.             Me.OLEObjects("image" & i).Object.Picture = LoadPicture(arrf(1, n))
    
21.         Next
    
22.     Next
    
23. End Sub

复制代码

下面代码会快一点，你这个程序我看的还不是很明白，好好研究下要

1. Private Sub CommandButton1_Click() '随机抽取5个，怎么都是生成5个一样的？？？而且插入时要很长时间。
   
2.     Dim MyPath$, m&, n&, mf&, arrf$(), v&, Fso As Object, ar(1 To 54)
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.         .InitialFileName = ThisWorkbook.Path & ""
   
5.         If .Show = False Then Exit Sub
   
6.     MyPath = .SelectedItems(1) & ""
   
7.     End With
   
8.     Application.ScreenUpdating = False
   
9.     Application.DisplayAlerts = False
   
10.    
    
11.     Set Fso = CreateObject("Scripting.FileSystemObject")
    
12.     Set Folder = Fso.GetFolder(MyPath)
    
13.     Call GetFiles(MyPath, sFileType, Fso, arrf, mf)
    
14.     For i = 1 To 5 '随机抽取5个
    
15.         Randomize
    
16.         n = Rnd * (21 - i) + 1
    
17.         m = IIf(ar(n) > 0, ar(n), n)
    
18.         ar(n) = IIf(ar(55 - i) > 0, ar(55 - i), 55 - i)
    
19.         Me.OLEObjects("image" & i).Object.Picture = LoadPicture(arrf(1, n))
    
20.     Next
    
21. End Sub

复制代码

上面两个代码生成的时候会有可能产生重复的，以下代码不会有重复出现，而且不需要设置个数，但是你之前的代码那么做我有点不了解，不知道是不是还有他用！

1. Private Sub CommandButton1_Click() '随机抽取5个，怎么都是生成5个一样的？？？而且插入时要很长时间。
   
2.     Dim MyPath$, m&, n&, mf&, arrf$(), v&, Fso As Object, ar(1 To 54), dc As Object, arr
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.         .InitialFileName = ThisWorkbook.Path & ""
   
5.         If .Show = False Then Exit Sub
   
6.     MyPath = .SelectedItems(1) & ""
   
7.     End With
   
8.     Application.ScreenUpdating = False
   
9.     Application.DisplayAlerts = False
   
10.     Set dc = CreateObject("scripting.dictionary")
    
11.     Set Fso = CreateObject("Scripting.FileSystemObject")
    
12.     Set Folder = Fso.GetFolder(MyPath)
    
13.     Call GetFiles(MyPath, sFileType, Fso, arrf, mf)
    
14.     On Error Resume Next
    
15.     With dc
    
16.         Do   '生成5个完全不同的随机数
    
17.             Randomize
    
18.             .Add Int(Rnd * mf + 1), ""
    
19.         Loop Until .Count = 5
    
20.         arr = .keys
    
21.     End With
    
22.     For i = 0 To 4
    
23.         Me.OLEObjects("image" & i + 1).Object.Picture = LoadPicture(arrf(1, arr(i)))
    
24.     Next
    
25. End Sub

复制代码

张雄友

老司机带带我 发表于 2016-5-31 20:45
代码修改了一下，你看下：下面代码会快一点，你这个程序我看的还不是很明白，好好研究下要上面两个代码生成 ...

能搞个完整的附件吗？没网络又得用手机上了，这世道！！

老司机带带我

我只上传表格附件，图片附件就不上传了！