想学习随机抽取~~~~~~~~~~~~~~~~~~~~~~

fdy1995312 · 发表于 2018-8-22 21:23

点击按钮，A2从菜谱A列里随机抽取一个，B2，B3从菜谱B列里随机抽取出俩个不一样的，C2从菜谱C列里随机抽取一个

jiminyanyan · 发表于 2018-8-22 21:33

http://club.excelhome.net/thread-883690-1-1.html

719404338 · 发表于 2018-8-22 21:43

Sub t()
Dim arr, brr, crr, i%, j%, k%
arr = Sheet2.[a2:a12]
brr = Sheet2.[b2:b16]
crr = Sheet2.[c2:c7]
[a2] = arr(Application.RandBetween(1, 11), 1)
0 i = Application.RandBetween(1, 15)
j = Application.RandBetween(1, 15)
k = Application.RandBetween(1, 6)
If i = j Then GoTo 0
[b2] = brr(i, 1)
[b3] = brr(j, 1)
[c2] = crr(k, 1)
End Sub

复制代码

chxw68 · 发表于 2018-8-22 21:53

Sub 随机菜单()
Dim r%, i%
Dim arr(1 To 3), brr
Randomize Timer
brr = [{1,2,1}]
With Worksheets("菜谱")
For j = 1 To 3
r = .Cells(.Rows.Count, j).End(xlUp).Row
arr(j) = .Cells(2, j).Resize(r - 1, 1)
Next
End With
With Worksheets("今日菜单")
For k = 1 To UBound(brr)
For i = 1 To Application.Min(brr(k), UBound(arr(k)) - 1)
m = Int((UBound(arr(k)) - i) * Rnd()) + 1 + i
temp = arr(k)(i, 1)
arr(k)(i, 1) = arr(k)(m, 1)
arr(k)(m, 1) = temp
Next
For i = 1 To Application.Min(brr(k), UBound(arr(k)) - 1)
.Cells(i + 1, k) = arr(k)(i, 1)
Next
Next
End With
End Sub

复制代码

chxw68 · 发表于 2018-8-22 21:53

详见附件。

xiangbaoan · 发表于 2018-8-22 21:59

………………………………

hcm19522 · 发表于 2018-8-23 11:17

E2:G3{=IF(OR((ROW(A1)-1)*3+COLUMN(A1)={4,6}),"",INDEX(A:A,LARGE(IF((A$2:A$16>0)*(COUNTIF(E$1:E1,A$2:A$16)=0),ROW(A$2:A$16)),RANDBETWEEN(1,COUNTA(A$2:A$16)+1-ROW(A1)))))

E7:G8{=INDEX(A:A,LARGE(IF((A$2:A$16>0)*(COUNTIF(E$6:E6,A$2:A$16)=0),ROW(A$2:A$16)),RANDBETWEEN(1,COUNTA(A$2:A$16)+1-ROW(A1))))

E8:G8格式化 =COLUMN(A1)<>2

A2:C16格式化 (針對E2:G3)=COUNTIF(E$2:E$3,A2)

zopey · 发表于 2018-8-23 11:38

我以前做的一个例子

随机菜谱.zip (19.71 KB, 下载次数: 4)

zhang6029 · 发表于 2018-8-24 13:03

Sub 随机菜单()

Dim i, j, n, m As Integer

i = Int((12 - 2 + 1) * Rnd + 2)
j = Int((16 - 2 + 1) * Rnd + 2)
m = Int((16 - 2 + 1) * Rnd + 2)
Do While m = j
m = Int((16 - 2 + 1) * Rnd + 2)
Loop
n = Int((7 - 2 + 1) * Rnd + 2)
Range("A2") = Sheets("菜谱").Range("A" & i)
Range("B2") = Sheets("菜谱").Range("B" & j)
Range("B3") = Sheets("菜谱").Range("B" & m)
Range("C2") = Sheets("菜谱").Range("C" & n)

End Sub

		自动登录	找回密码
密码			免费注册

[求助] 想学习随机抽取~~~~~~~~~~~~~~~~~~~~~~