随机抽取函数

随机抽取函数(For VBScript) [原创 2006-10-26 11:56:29 ] 发表者: xmxoxo    

        经常需要在一些记录中随机抽取一些记录，在广告，新闻，考试题目生成的时候常用到，这里把
以前的函数稍加整理发表出来，与大家分享。
        GetRand函数有两个参数，第一个是待抽取的数值，用","分隔，第二个是要抽取的个数，函数返回一个字符串，是用',"分隔的已抽取的内容。实际应用的时候，可以把广告，考题，新闻等的记录ID，或者其它关键字，先生成一个字符串，比如“111,112,115,118,120,129,138,332,335"这样的形式，(xmxoxo提示：你可以用oRs.Getstring(2,,",",",")方法来生成),然后调用GetRand函数,例如:
sIdList =  GetRand (sIdList,  10) 这样得到的sIdList就是随机得到的ID列表了,再用
"select * from tablewhere id in (" & sIdList & ")"
来读出记录。

缺点：不适合用在太多记录的地方，如果有上千条记录要随机抽取上百条，可能效率比较差。

 

'----------------------------------------------------------
'随机抽取函数
'参数
' aText  待抽取的数值，用","分隔
' iPick  抽取的个数
'返回值
' 字符，已抽取的数值用',"分隔
'write by xmxoxo 2006-1-10 at XiaMen
'----------------------------------------------------------
Function GetRand (byval aText, byval iPick)
Dim aTmp,i,sRet,iCount , iRnd
'判断数值格式
If aText& ""="" or InStr (aText,",")<=0 Then
 GetRand=""
 exit function
End If
If not IsNumeric (iPick) Then
 GetRand=""
 exit function
else
 iPick=CLng (iPick)
End If
'生成数值数组
aTmp=Split (aText, ",")
iCount=ubound(aTmp)
'判断抽取个数与实际个数
If iCount=0 or iCount+1 < iPick or iPick = 0 Then
 GetRand = aText
 exit function
End If
'开始抽取
'写入随机数
Randomize 
i=0
Do While i< iPick
 iRnd=Int (Rnd ()* iCount )
 If aTmp(iRnd)<>"" Then
  If sRet<>"" Then
   sRet = sRet & ","
  End If
  sRet = sRet & aTmp(iRnd)
'删除选中的数组值
  For j =iRnd  to iCount-1
   aTmp(j)= aTmp(j+1)
  Next
  iCount= iCount-1
  ReDim Preserve aTmp(iCount)
  i=i+1
 End If
Loop
GetRand =sRet
End Function