【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

fjh

已被收藏

nncchh

学习下

nncchh

谢谢分享

wuweipaopao

谢谢分享！

szyewj

很好！很强大！支持精品原創作~

greatcf

感谢了

cclxf

谢谢分享

dragonszr

todaynew,一定要收藏!

yanwei82123300

谢谢todaynew代码收藏了。