پیدا کردن دوتا از پایین ترین اعداد کارنامه

[mr_bean_irani]

باسلام
من نمرات ارزشیابی که 13 گزینه دارد را دارم و میخوام گزارشی بدم با این شرایط

دو شاخصی که کمترین امتیاز رو طرف کسب کرده

بعنوان مثال :



نام

Q1
Q2
Q3
Q4
Q5
Q6
Q7
Q8
Q9
Q10
Q11
Q12
Q13
minimum-1
minimum-2


علی
5
5
5
5
5
5
5
5
5
5
5
1
5
Q12
-


رضا
4
4
5
3
5
5
3
3
5
4
3
4
4
Q4
Q7


محمد
4
4
4
4
3
4
4
4
4
4
5
4
4
Q5
Q1



در این نمونه علی در سوال 12 امتیاز 1 را گرفته و در گزینه های دیگر امتیاز کامل
رضا در سوال 4 امتیاز 3 را کسب نموده و همینطور سوال 7
محمد در سوال 5 کمتزین امتیار رو گرفته ولی چون دیگه 3 نداشته کمترین نمره بعد از عدد 3 میشود 4 و اولین نمره 4 در سوال 1 میباشد
من برای 9000 نفر چون باید اینو محاسبه کنم چکار باید انجام بدم ؟
چه اکسس یا اکسل
ممنونم از دوستان که کمک خواهند کرد

[mazoolagh]

پرسش جالبی هست
درسته که دارای نکته خاص و پیچیده ای نیست که تابحال در این انجمن مطرح نشده باشه، با این وجود خالی از لطف هم نیست!
بخصوص که توضیحات دقیق و کافی هم داده شده

با فرض اینکه طراحی جدول چیزی شبیه زیر باشه:
144382

کد به صورت زیر خواهد بود:


Option Compare Database
Option Explicit
Const MinScore As Integer = 1
Const MaxScore As Integer = 5
Const QuestionsCount As Integer = 13
Const RecordsCount As Integer = 9000
Private i, j As Integer

Public Sub Find_Minimums()
Dim RS As Recordset
Set RS = CurrentDb.OpenRecordset("Scores")
Dim P1, P2, M1, M2 As Integer ' positions and minimum values
Dim M1L, M2L As String ' list of positions of minimum values
Dim MX As Integer
Do While Not RS.EOF
' pass 1 : find first minimum
P1 = 1
M1 = RS("Q1")
For j = 2 To QuestionsCount
If RS(Qx(j)) < M1 Then
M1 = RS(Qx(j)) ' minimum value
P1 = j ' position
End If
Next
RS.Edit
' pass 2 : find second minimum
RS(Qx(P1)) = MaxScore + 1 ' exclude first minimum value from comparison list
P2 = 1
M2 = RS("Q1")
For j = 2 To QuestionsCount
If RS(Qx(j)) < M2 Then
M2 = RS(Qx(j))
P2 = j
End If
Next
RS(Qx(P1)) = M1 ' restore original value before saving
RS("Min1") = IIf(M1 = 5, "---", Qx(P1))
RS("Min2") = IIf(M2 = 5, "---", Qx(P2))
'==== optional: creates a list of Qs having minimum values ====
M1L = ""
M2L = ""

If M1 < MaxScore Then
For j = 1 To QuestionsCount
If RS(Qx(j)) = M1 Then
M1L = M1L + Trim(j) + ","
End If
Next
End If
If M1L <> "" Then M1L = Left(M1L, Len(M1L) - 1)

If M2 < MaxScore Then
If M2 <> M1 Then
For j = 1 To QuestionsCount
If RS(Qx(j)) = M2 Then
M2L = M2L + Trim(j) + ","
End If
Next
Else ' find a different minimum
MX = MaxScore + 1
For j = 1 To QuestionsCount
If RS(Qx(j)) < MX And RS(Qx(j)) <> M1 Then
MX = RS(Qx(j))
End If
Next
If MX < MaxScore And MX <> M1 Then
For j = 1 To QuestionsCount
If RS(Qx(j)) = MX Then
M2L = M2L + Trim(j) + ","
End If
Next
End If
End If
If M2L <> "" Then M2L = Left(M2L, Len(M2L) - 1)
End If
RS("Min1List") = M1L
RS("Min2List") = M2L
'================================================= =============
RS.Update
RS.MoveNext
Loop
RS.Close
Set RS = Nothing
End Sub



لازم به توضیح هست که از کد زیر برای ساخت جدول استفاده شده (بجای نوشتن 13 فیلد!)


Public Sub CreateTables()
On Error GoTo AlreadyCreated
CurrentDb.Execute "CREATE TABLE Scores (ID AUTOINCREMENT PRIMARY KEY,Student CHAR)"
For i = 1 To QuestionsCount
CurrentDb.Execute "ALTER TABLE Scores ADD COLUMN Q" + Trim(i) + " SHORT"
Next
CurrentDb.Execute "ALTER TABLE Scores ADD COLUMN Min1 CHAR,Min2 CHAR,Min1List CHAR,Min2List CHAR"
AlreadyCreated:
End Sub


و برای پر کردن اون با اطلاعات رندوم و تست کد:

Public Sub Fill_Scores() ' fills Scores table with random data
Randomize Timer
CurrentDb.Execute "DELETE FROM Scores"
Dim RS As Recordset
Set RS = CurrentDb.OpenRecordset("Scores")
Dim L, U As Integer ' lower and upper score limits
Dim Score As Integer
For i = 1 To RecordsCount
RS.AddNew
RS("Student") = "Student " + Format(i, "00000")
L = Random_Range(MinScore, MaxScore) ' random lower score
U = Random_Range(L, MaxScore) ' random upper score
For j = 1 To QuestionsCount
Score = Random_Range(L, U) ' random score
RS(Qx(j)) = Score
Next
RS.Update
Next
RS.Close
Set RS = Nothing
End Sub


چیزی که برای من جای سؤال داشت این بود که در این نوع مسائل معمولا خواسته میشه که لیستی از گزینه ها ساخته بشه:
بعنوان مثال در همین دیتا نمونه برای رضا لیست یک میشه Q4,Q7,Q8,Q11 و لیست دو میشه Q1,Q2,Q10,Q12,Q13

اون بخشی که بعنوان optional مشخص شده کارش ساخت همین لیست هست

[mr_bean_irani]

باسلام و احترام
ميشه خواهش كنم به تلگرام من يه پيام بديد
Mr_bean_irani
ويا
MR_bean_iranii
سپاسگزارم

[mazoolagh]

سلام
میتونین به همین آیدی mazoolagh در یاهو ایمیل بفرستین