[已解决]编写一个自定义函数 实现随机不重复抽取功能

s2y4h6

该函数有两个参数和返回值，一个参数是一维数组，另外一个是需要不重复抽取的个数。返回值是一个新的数组。目前遇到困难了，返回值不知道该怎么写代码。偶尔参数数组还会下标越界。
请各路大神帮忙看一下。在线等，挺急的

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-5-25 16:56

不会改变，建议学习一下传值和传址。
原代码修改一下，把原始数组一起输出至D列供参考。

1. Option Base 1
   
2. Public Function GetRnd(arr, n)
   
3. Dim brr, r&, m&
   
4. ReDim brr(1 To n)
   
5. Randomize
   
6. Do
   
7.   m = Int(Rnd() * UBound(arr) + 1)
   
8.   If arr(m) <> "" Then
   
9.     r = r + 1
   
10.     brr(r) = arr(m): arr(m) = ""
    
11.   End If
    
12. Loop Until r = n
    
13. GetRnd = brr
    
14. End Function
    
15. Sub aaa()
    
16. Dim a
    
17. Dim arr1
    
18. arr1 = Range("a1:a6")
    
19. a = GetRnd(Application.Transpose(arr1), 3)
    
20. [b1].Resize(3, 1) = Application.Transpose(a)
    
21. [d1].Resize(UBound(arr1)) = arr1
    
22. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Option Base 1
   
2. Public Function GetRnd(arr, n)
   
3. Dim brr, r&, m&
   
4. ReDim brr(1 To n)
   
5. Randomize
   
6. Do
   
7.   m = Int(Rnd() * UBound(arr) + 1)
   
8.   If arr(m) <> "" Then
   
9.     r = r + 1
   
10.     brr(r) = arr(m): arr(m) = ""
    
11.   End If
    
12. Loop Until r = n
    
13. GetRnd = brr
    
14. End Function
    
15. Sub aaa()
    
16. Dim a
    
17. Dim arr1
    
18. arr1 = Range("a1:a6")
    
19. a = GetRnd(Application.Transpose(arr1), 3)
    
20. [b1].Resize(3, 1) = Application.Transpose(a)
    
21. End Sub

复制代码

s2y4h6

大灰狼1976 发表于 2017-5-25 16:22

8到10行有点疑问，这样子直接把arr(m)=空值，会不会把函数过程外边的arr改变？函数外边的参数数组的值是不能改变的

大灰狼1976

不会改变，建议学习一下传值和传址。
原代码修改一下，把原始数组一起输出至D列供参考。

1. Option Base 1
   
2. Public Function GetRnd(arr, n)
   
3. Dim brr, r&, m&
   
4. ReDim brr(1 To n)
   
5. Randomize
   
6. Do
   
7.   m = Int(Rnd() * UBound(arr) + 1)
   
8.   If arr(m) <> "" Then
   
9.     r = r + 1
   
10.     brr(r) = arr(m): arr(m) = ""
    
11.   End If
    
12. Loop Until r = n
    
13. GetRnd = brr
    
14. End Function
    
15. Sub aaa()
    
16. Dim a
    
17. Dim arr1
    
18. arr1 = Range("a1:a6")
    
19. a = GetRnd(Application.Transpose(arr1), 3)
    
20. [b1].Resize(3, 1) = Application.Transpose(a)
    
21. [d1].Resize(UBound(arr1)) = arr1
    
22. End Sub

复制代码

s2y4h6

大灰狼1976 发表于 2017-5-25 16:56
不会改变，建议学习一下传值和传址。
原代码修改一下，把原始数组一起输出至D列供参考。

嗯 正在看按值传递和按址传递。好晕，毕竟不是专业出身。。。
还有个问题，我在做的其实是一个随机不重复抽取数据的东东。需要从很多列中的数据多次抽取，我想要的结果是每一次随机抽取的时候不受到上一次抽取的影响。
函数参数上到底应该写byref 还是byval呢？

大灰狼1976

不用纠结，现在的代码就是传值的，不会影响下次抽取。

s2y4h6

大灰狼1976 发表于 2017-5-25 17:04
不用纠结，现在的代码就是传值的，不会影响下次抽取。

那么要是写上byval会有什么后果？我试了一下 发现没啥改变啊 ？

大灰狼1976

byval就是传值

s2y4h6

大灰狼1976 发表于 2017-5-25 17:10
byval就是传值

大神，帮忙解答一下这问题吧  这写上byval和不写竟然完全一样，按照教程写的，按理说数组传递到函数里边了，函数里边是有改变数组的代码的，外边的原始数组怎么没收到影响呢？{:021:}

大灰狼1976

VBA函数默认为传址，也就是说会改变源数据，但是为什么没有变化呢，因为你的实参并不是ARR1，而是APPLICATION.TRANSPOSE(ARR1)，所以ARR1不会被改变。