数据集并没有按SQL预期内容打开，估计是使用ADODB.Recordset的原因，更改为以下后正常
Sub Update()
'Dim rst As New ADODB.Recordset,
Dim FNum As Double, FSumNum As Double, FCount As Long, FMaxP As Double, FTdays As Long, FBudget As Long
Dim HiPay As Double, Lopay As Double, FPitDiff As Double, FRange As Double, FPercent As Double, FCoutoff As Double, FWscores As Double
FNum = DLookup("Benchmark", "Benchmark")
FTdays = DLookup("Totaldays", "Benchmark")
FMaxP = DLookup("MaxPoint", "Benchmark")
FBudget = DLookup("Budget", "variables")
FPercent = DLookup("HiUp", "variables")
Dim rst As Object
Dim strsql As String
Dim i As Integer
strsql = "SELECT MADays, Score FROM Eligible order by Score DESC"
Set rst = CurrentDb.OpenRecordset(strsql, 2)
With rst
' .ActiveConnection = CurrentProject.Connection
' .CursorType = adOpenStatic
' .LockType = adLockOptimistic
' .Source = "SELECT MADays, Score FROM Eligible order by Score DESC"
' .Open
Do Until .EOF
FMaxP = .Fields("MADays")
FSumNum = FSumNum + .Fields("MADays")
FWscores = FWscores + .Fields("Score") * .Fields("MADays")
i = i + 1
If FSumNum > FNum Then
FCount = .AbsolutePosition
FCutOff = .Fields("Score")
FRange = FMaxP - FCutOff
FPitDiff = FSumNum + (FWscores - FCutOff * FSumNum) / FRange
Lopay = Round(FBudget / FPitDiff, 2)
HiPay = Round(Lopay * FPercent, 2)
Exit Do
End If
.MoveNext
Loop
End With
With Me
.Text0 = FNum
.Text2 = FMaxP
.Text5 = FBudget
.Text7 = FPercent
' .Text9 = FCount
.Text21 = FSumNum
.Text15 = Format(Lopay, "0.00")
.Text17 = Format(HiPay, "0.00")
.Text11 = FCutOff
.Text9 = i
End With
End Sub
