שליפת רשומה רנדומאלית באקסס

spider

@spider
הגרלה, לפי הידוע לי, אפשר לעשות רק על מספר.
לא יודע אם יש דרך לעשות הגרלה דרך אקסס לבד, עם VBA תוכל לעשות את זה.
אתה מכיר קצת VBA?

זה שלא.
אני חדש בתחום

spider

@מלא אפשר אולי לעשות הגרלה על מספר מטבלה (ID),
ושיביא את כל השורה בטבלה?

ככה הוא יביא גם את הID וגם את הטקסט

מלא

@spider
כמובן.

תנסה את זה:

dlookup("עמודהשם", "טבלה", "עמודהID=" &  Int((DMAX("עמודהID","טבלה")  - 1 + 1) * Rnd + 1))

זה בהנחה שכל המספרים מלאים והמספור מתחיל ב1, אם יש מספרים ריקים, לפעמים הוא לא יחזיר כלום.

https://www.techonthenet.com/access/functions/numeric/rnd.php

מלא

פוסט זה נמחק!

OdedDvir

@spider לאקסס אין מנגנון מובנה לשליפת רשומה אקראית, אבל מייקרוסופט הואילו בטובם לספק קוד שכזה.
צור מודל חדש ותדביק בו את הקוד הבא:

Public Function FindRandom(RecordSetName As String, Fieldname As String) 
 
 Dim MyDB As Database 
 Dim MyRS As Recordset 
 Dim SpecificRecord As Long, i As Long, NumOfRecords As Long 
 
 Set MyDB = CurrentDB() 
 Set MyRS = MyDB.OpenRecordset(RecordSetName, dbOpenDynaset) 
 On Error GoTo NoRecords 
 MyRS.MoveLast 
 NumOfRecords = MyRS.RecordCount 
 SpecificRecord = Int(NumOfRecords * Rnd) 
 If SpecificRecord = NumOfRecords Then 
   SpecificRecord = SpecificRecord - 1 
 End If 
 MyRS.MoveFirst 
 For i = 1 To SpecificRecord 
   MyRS.MoveNext 
 Next i 
 FindRandom = MyRS(Fieldname) 
 Exit Function 
 
NoRecords: 
 If Err = 3021 Then 
   MsgBox "There Are No Records In The Dynaset", 16, "Error" 
 Else 
   MsgBox "Error - " & Err & Chr$(13) & Chr$(10) & Error, _ 
     16, "Error" 
 End If 
 FindRandom = "No Records" 
 Exit Function 
 
End Function

כעת במקור הנתונים של תיבת הטקסט תכניס את הנוסחא:

=FindRandom("שם_הטבלה_שלך","שם_השדה_הרצוי")

dovid

@OdedDvir אפשר ע"י שאילתה שממיינת לפי מספר אקראי ולוקחת את הראשון (SELECT TOP 1).
https://stackoverflow.com/a/35457559/1271037
אבל מבחינת ביצועים הקוד שלך הרבה יותר טוב.

dovid

@dovid אמר בשליפת רשומה רנדומאלית באקסס:

אבל מבחינת ביצועים הקוד שלך הרבה יותר טוב.

אני כבר לא בטוח, אני רואה שגם בקוד שלהם יש מעבר על כל השורות, בשביל מה?
אי אפשר לגשת למשפר השורות בלי MoveLast? ולמה MyRS.MoveNext בלולאה, אין פקודה לנוע מספר נתון ישירות?

מלא

@dovid אמר בשליפת רשומה רנדומאלית באקסס:

אי אפשר לגשת למשפר השורות בלי MoveLast?

https://docs.microsoft.com/en-us/office/vba/access/concepts/data-access-objects/count-the-number-of-records-in-a-dao-recordset
ככה הם אומרים.
http://www.baldyweb.com/RecordCounts.htm

ולמה MyRS.MoveNext בלולאה, אין פקודה לנוע מספר נתון ישירות?

כן יש, rs.move 10
שאלות, על המדריך שם..

OdedDvir

@dovid האמת היא שלא טרחתי אפילו לעבור על הקוד, פשוט העתק הדבק ממיקרוסופט.
אבל בודאי שעדיף לקפוץ ישירות לרשומה הרצויה על ידי Move. בנוסף, מצאתי טעות בקוד שלהם, חסרה להם MoveFirst אחרי הפקודה MyRS.MoveLast (משום מה לא מופיעים מספרי שורות לעיל)
וגם הצהרה מפורשת שמדובר ב DAO.Recordset (זה כנראה קוד ישן מאוד...)
להלן הפונקציה המשופרת:

Public Function FindRandom(RecordSetName As String, Fieldname As String)
 
    Dim MyDB As DAO.Database
    Dim MyRS As DAO.Recordset
    Dim SpecificRecord As Long, i As Long, NumOfRecords As Long
 
    Set MyDB = CurrentDb()
    Set MyRS = MyDB.OpenRecordset(RecordSetName, dbOpenDynaset)
    On Error GoTo NoRecords
    MyRS.MoveLast
    NumOfRecords = MyRS.RecordCount
    SpecificRecord = Int(NumOfRecords * Rnd)
    If SpecificRecord = NumOfRecords Then
        SpecificRecord = SpecificRecord - 1
    End If
    MyRS.MoveFirst
    MyRS.Move SpecificRecord

    FindRandom = MyRS(Fieldname)
    Exit Function
 
NoRecords:
    If Err = 3021 Then
        MsgBox "There Are No Records In The Dynaset", 16, "Error"
    Else
        MsgBox "Error - " & Err & Chr$(13) & Chr$(10) & Error, _
                                                      16, "Error"
    End If
    FindRandom = "No Records"
    Exit Function
 
End Function

במחשבה שניה אפשר לוותר גם על MoveFirst לחלוטין ופשוט לזוז אחורה מספר רנדומלי, כך:

' MyRS.MoveFirst
 MyRS.Move -SpecificRecord

WWW

@dovid אמר בשליפת רשומה רנדומאלית באקסס:

@dovid אמר בשליפת רשומה רנדומאלית באקסס:
אי אפשר לגשת למשפר השורות בלי MoveLast?

אי אפשר, וגם ככה צריך רחמים גדולים, כי המספר לא מדוייק, לא ברור למה.

spider

@OdedDvir דבר ראשון תודה ענקית הקוד עזר לי מאוד!!!

למה כל פעם כשאני פותח את הטופס, שאליו מוזן הרשומה רנדומאלית, מוצגת לי ההודעה הבאב:

OdedDvir

@spider אני מנחש שהשאילתא שממנה אתה מנסה לשלוף את הרשומה, היא גם השאילתא שעליה מבוסס גם הטופס, או שלכל הפחות היא כבר פתוחה בטופס אחר?
במקרה כזה השאילתא ננעלת, וממילא לא תוכל לפתוח אותה בקוד הנ"ל. (כי הוראת הפתיחה בו היא לפתיחה דינמית שמאפשרת שינויים).
אתה צריך לשנות את השורה 8 בקוד, דהיינו את:

    Set MyRS = MyDB.OpenRecordset(RecordSetName, dbOpenDynaset)

לשורה הבאה:

    Set MyRS = MyDB.OpenRecordset(RecordSetName, dbReadOnly, dbOpenSnapshot)

תחומים - פורום חרדי מקצועי

שליפת רשומה רנדומאלית באקסס