【Access小品】定量不重复随机抽选

todaynew

这是一个基于石三少同志的一个问题编写的实例。问题本身有一定的普遍意义，也就是解决循环随机定量抽检问题。这个问题本身隐含着一个容易导致思维模糊的算法，即：是定率还是定量？

随机从一批货物或者设备中按照一定比例不重复循环抽检，初看起来应该是一个定率抽检问题。其实不然，这实际是一个定量抽检问题。也就是说由于“不重复的存在”，就导致每次抽检不能按照固定的比例进行，而需要按照第一次算出的固定数量进行。






Private Sub 随机抽样(抽样比例 As Single)
Dim rs0 As New ADODB.Recordset
Dim ssql0 As String
Dim rs1 As New ADODB.Recordset
Dim ssql1 As String
Dim i As Long, j As Long
Dim MyValue As Long
Dim str As String
Dim M(1 To 3) As Long
ssql0 = "SELECT 部门 FROM 基础表 GROUP BY 部门;"
rs0.Open ssql0, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 1 To rs0.RecordCount
    M(i) = Int(DCount("*", "基础表", "部门='" & rs0("部门").Value & "'") * 抽样比例)
    rs0.MoveNext
Next
rs0.MoveFirst
For i = 1 To rs0.RecordCount
    str = "部门='" & rs0("部门").Value & "' and 次=0"
    For j = 1 To M(i)
        ssql1 = "select * from 基础表 where " & str
        rs1.Open ssql1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
        MyValue = Int(rs1.RecordCount * Rnd + 1)
        If Not (rs1.EOF Or rs1.BOF) Then
            rs1.Move MyValue - 1
            rs1("次") = Me.次.Value + 1
            rs1.Update
        End If
        rs1.Close
    Next
    rs0.MoveNext
Next
Me.子窗体.Form.Requery
Me.次.Requery
Me.次.Value = Me.次.ListCount - 1
End Sub

chaojianan

谢谢todaynew代码收藏了。
支持。

ui

最好老兄 精品不断!!

ycxchen

最好老兄 精品不断,真的！

koutx

新年好，学习了

todaynew

谢谢同志们鼓励，并祝节日愉快！

goto2008

留个脚印。。。谢谢分享

5988143

祝节日愉快

yanwei82123300

谢谢todaynew代码收藏了。

dragonszr

todaynew,一定要收藏!