Dear side of the phone you okay?
It started yet, this long holiday how was?
We should will encounter a variety of scheduling problems in development, today to share the sort of values (the sort of performance).
Let's look at in terms of demand, the existing set of values, need to get the value of the order of descending order, if the value of the same in the same order is obtained.
We or the old rules, a step by step to operate.
01
First, the construction of the table
First, as we need to build a table
Next enter some data
02
Second, build forms
This form is somewhat complex, the default view of the form is a continuous form, record a snapshot set type, button names cleared sort of btnCancel, buttons name sort of btnOrder.
Like similar continuous form in the figure below, we will talk about later, I not go into here.
03
Third, add code
Code has been written to you, it can bring directly.
Empty sort button click event
1Private Sub btnCancel_Click()
2
3 CurrentDb.Execute "UPDATE tblHochsprung SET tblScore.Rang = 0;"
4 Me.Requery
5End Sub
Sort button click event
1Private Sub btnOrder_Click()
2 If Not RangBerechnen("tblScore", "Score") Then
3 MsgBox "排序失败"
4 End If
5 Me.Requery
6End Sub
Sort custom function
1Private Function RangBerechnen(TableName As String, LeistungFeld As String) As Boolean
2 On Error GoTo ErrorHandler
3 Dim rst As Object ' Recordset
4 Dim iRang As Byte
5 Dim iLeistung As Integer
6 Dim iGleicherRang As Integer
7 Set rst = CurrentDb.OpenRecordset("SELECT * FROM " & TableName & " ORDER BY " & LeistungFeld & " DESC", dbOpenDynaset)
8 iRang = 1
9
10
11 Do While Not rst.EOF
12 iLeistung = rst.Fields(LeistungFeld)
13 rst.Edit
14 rst!Rang = iRang
15 rst.Update
16 rst.MoveNext
17 If rst.EOF Then Exit Do
18 iGleicherRang = 0
19 Do While (rst.Fields(LeistungFeld) = iLeistung) '判断是否是相同的数值，如果是相同的，顺序+1
20 rst.Edit
21 rst!Rang = iRang
22 rst.Update
23 iGleicherRang = iGleicherRang + 1
24 rst.MoveNext
25 If rst.EOF Then Exit Do
26 Loop
27 iRang = iRang + 1 + iGleicherRang
28 Loop
29 rst.Close
30
31 RangBerechnen = True
32 Set rst = Nothing
33Exit_Rang:
34 Exit Function
35
36ErrorHandler:
37 MsgBox Err.Description, vbCritical
38 RangBerechnen = False
39 Resume Exit_Rang
40
41End Function
04
Fourth, the test run
Results are as follows in FIG.
Well, go and try it.
Wuhan Come on, Come on, China!
