اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

وعليكم السلام ورحنة الله تعالى وبركاته

 

ممكن من خلال الكود التالى  فى وحده نمطية عامة مثلا باسم : basGetDatesBetween

Public Function GetDatesBetween(ByVal dtmStartDate As Date, ByVal dtmEndDate As Date) As String
    If dtmStartDate > dtmEndDate Then
        GetDatesBetween = ""
    Exit Function
    End If
    
    Dim dtmCurrentDate As Date
    Dim arrDates() As String
    ReDim arrDates(0 To DateDiff("d", dtmStartDate, dtmEndDate))
    Dim lngIndex As Long
    For dtmCurrentDate = dtmStartDate To dtmEndDate
        arrDates(lngIndex) = Format(dtmCurrentDate, "yyyy-mm-dd")
        lngIndex = lngIndex + 1
    Next dtmCurrentDate
    GetDatesBetween = Join(arrDates, " | ")
End Function

على ان يكون الاستدعاء فى الاستعلام لعمل حقل التواريخ بالشكل التالى
 

DateList: GetDatesBetween([startA],[endA])

لتكون جملة الاستعلام كاملة كما يلى

SELECT 
    tbl1.user_id, 
    GetDatesBetween([startA], [endA]) AS DateList
FROM 
    tbl1;

ويمكن خفظ الاستعلام مثلا باسم : qryUserDateList

لا اعرف هل الفكرة تلبى الطلب ام لا


خطر على بالى ايضا اضفة استعلام جديد يعتمد على الاستعلام السابق
لنعط مثلا للاستعلام الجديد اسم qryFilteredDates
وتكون جملة الاستعلام بالشكل التالى 

 

SELECT *
FROM qryUserDateList
WHERE DateList LIKE "*" & Format([InbutFromDate], "yyyy-mm-dd") & "*"
    OR DateList LIKE "*" & Format([InbutToDate], "yyyy-mm-dd") & "*";

 

أو مثلا لو أردنا تمرير التواريخ من نموذج 

SELECT *
FROM qryUserDateList
WHERE DateList LIKE "*" & Format(Forms!frmSearch!txtFromDate, "yyyy-mm-dd") & "*"
    OR DateList LIKE "*" & Format(Forms!frmSearch!txtToDate, "yyyy-mm-dd") & "*";

وظيفة الاستعلام الاخير qryFilteredDates
أذا كنا نريد البحث في DateList إن كانت تحتوي على أي تاريخ بين النطاقين

وذلك لأنه لا يمكن تصفية نتيجة دالة GetDatesBetween بشكل مباشر باستخدام WHERE

 

قام بنشر

تمام ابا جودي

الفكرة هي اني استبعد انشاء جدول من العملية

باقي تكة

1- ان تكون النتيجة كسجلات  ومرتبطة بالمعرف

يعني المعرف 11 يكون له 4 تواريخ فوق بعض  والمعرف 22 امامه تاريخ واحد

وتسلم يالغالي والف شكر .. 

  • Thanks 1
قام بنشر

يمكن كلمة " العرض في حقل واحد "  التي في العنوان عملت لبس في فهم المطلوب .. سوف اعدلها الى "العرض في قائمة"

  • ابوخليل changed the title to هل يمكن العرض في قائمة واحدة في استعلام تواريخ بين تاريخين من حقلين في جدول باستخدام SELECT فقط
قام بنشر
14 دقائق مضت, ابوخليل said:

باقي تكة

1- ان تكون النتيجة كسجلات  ومرتبطة بالمعرف

برضو بدون جداول ؟؟؟

قام بنشر

اذا لا يوجد حل .. او انه غير منطقي .. نلجأ الى شيء آخر يساعدنا

في المثال جدول tbl2  المساعد

يحتوي على تواريخ عدة

الآن اريد النتيجة في الاستعلام .. اظهار جميع التواريخ التي في tbl2  وما يتفق معها من جدول1

اريد المعرف وحقل تاريخ

يعني المعرف 11 يظهر له 4 سجلات  من 2/7 / الى  5/7  وسبب ظهورها هو ان لها ما يقابلها في جدول2

اعتذر اذا شرحي مش ولا بد 

Database2.rar

  • Thanks 1
قام بنشر
17 دقائق مضت, ابوخليل said:

يعني المعرف 11 يظهر له 4 سجلات  من 2/7 / الى  5/7  وسبب ظهورها هو ان لها ما يقابلها في جدول2

 

اذا الموضوع اسهل الان بوجود هذا الجدول المساعد

مباشرة وبدون اى اكواد ممكن عمل الاستعلام التالى 
 

SELECT tbl1.user_id, tbl2.dateField
FROM tbl1, tbl2
WHERE (((tbl2.dateField) Between [tbl1].[startA] And [tbl1].[endA]))
ORDER BY tbl1.user_id, tbl2.dateField;

 

ممكن الجدول المساعد tbl2
يتم عمل البيانات بداخله ديناميكا ليحتوى على كل تواريخ العام منذ بداية العام الى نهايته مثلا من خلال الكود التالى

Public Sub PopulateDateTable(Optional ByVal dtmStartDate As Date = 0, Optional ByVal dtmEndDate As Date = 0)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim dtmDate As Date
    Dim lngYearNow As Long

    ' الحصول على السنة الحالية
    lngYearNow = Year(Date)

    ' تعيين القيم الافتراضية إذا لم يتم تمريرها
    If dtmStartDate = 0 Then dtmStartDate = DateSerial(lngYearNow, 1, 1)
    If dtmEndDate = 0 Then dtmEndDate = DateSerial(lngYearNow, 12, 31)

    ' التأكد أن التاريخين صالحين
    If dtmStartDate > dtmEndDate Then
        MsgBox "تاريخ البداية أكبر من تاريخ النهاية!", vbExclamation
        Exit Sub
    End If

    Set db = CurrentDb

    ' مسح البيانات القديمة
    db.Execute "DELETE FROM tbl2", dbFailOnError

    ' فتح الجدول للإضافة
    Set rs = db.OpenRecordset("tbl2", dbOpenDynaset)

    ' ملء السجلات
    For dtmDate = dtmStartDate To dtmEndDate
        rs.AddNew
        rs!dateField = dtmDate
        rs.Update
    Next dtmDate

    ' تنظيف الموارد
    rs.Close
    Set rs = Nothing
    Set db = Nothing

    MsgBox "تم توليد التواريخ من " & Format(dtmStartDate, "yyyy-mm-dd") & " إلى " & Format(dtmEndDate, "yyyy-mm-dd"), vbInformation
End Sub

 

قام بنشر

طيب دى فكرة تانى لو لا تريد عمل جداول مؤقته او حتى جدول ثابت لمعالجة موضوع التواريخ
وان كنت لا تريد كذلك الاعتماد على جداول مساعدة كالجدول الاخير : tbl2

الكود 

Public Sub GenerateSafeUnionQuery()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim dtmStart As Date, dtmEnd As Date, dtmCurrent As Date
    Dim lngUserID As Long
    Dim strSQL As String
    Dim strOneLine As String
    Dim bolFirst As Boolean

    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT user_id, startA, endA FROM tbl1", dbOpenSnapshot)

    bolFirst = True

    Do Until rs.EOF
        lngUserID = rs!user_id
        dtmStart = Nz(rs!startA, 0)
        dtmEnd = Nz(rs!endA, 0)

        If IsDate(dtmStart) And IsDate(dtmEnd) And dtmStart <= dtmEnd Then
            For dtmCurrent = dtmStart To dtmEnd
                ' استخدام جدول فعلي لتجنب التكرارات
                strOneLine = "SELECT " & lngUserID & " AS user_id, #" & Format(dtmCurrent, "yyyy-mm-dd") & "# AS dateField FROM (SELECT TOP 1 * FROM tbl1)"

                If bolFirst Then
                    strSQL = strOneLine
                    bolFirst = False
                Else
                    strSQL = strSQL & vbCrLf & "UNION ALL" & vbCrLf & strOneLine
                End If
            Next dtmCurrent
        End If

        rs.MoveNext
    Loop

    rs.Close
    Set rs = Nothing

    ' حذف الاستعلام القديم (لو موجود)
    On Error Resume Next
    db.QueryDefs.Delete "qryUnioUserDates"
    db.QueryDefs.Delete "qryFinalUserDates"
    On Error GoTo 0

    ' إنشاء الاستعلام الأساسي UNION
    db.CreateQueryDef "qryUnioUserDates", strSQL

    ' إنشاء استعلام مبني عليه
    db.CreateQueryDef "qryFinalUserDates", "SELECT * FROM qryUnioUserDates;"

    ' إظهار الاستعلام مباشرة
    DoCmd.OpenQuery "qryFinalUserDates", acViewNormal

    MsgBox "تم إنشاء الاستعلامين بنجاح، والاستعلام النهائي تم فتحه.", vbInformation
End Sub



أفكار أخرى لا تعتمد على جدول مساعد او جدول مؤقت او حتى جدول ثابت
الكود الاساسى فى وحده نمطية عامة

Private Const adInteger = 3
Private Const adDBTimeStamp = 135
Private Const adOpenStatic = 3
Private Const adLockOptimistic = 3

Public Function GetSplitDatesRecordset() As Object
    Dim db As DAO.Database
    Dim rsSource As DAO.Recordset
    Dim rsTemp As Object
    Dim arrDates() As String
    Dim i As Long
    Dim lngUserID As Long
    Dim strDates As String

    Set rsTemp = CreateObject("ADODB.Recordset")
    rsTemp.Fields.Append "user_id", adInteger
    rsTemp.Fields.Append "SingleDate", adDBTimeStamp
    rsTemp.CursorType = adOpenStatic
    rsTemp.LockType = adLockOptimistic
    rsTemp.Open

    Set db = CurrentDb
    Set rsSource = db.OpenRecordset("SELECT user_id, GetDatesBetween([startA], [endA]) AS DateList FROM tbl1", dbOpenSnapshot)

    Do While Not rsSource.EOF
        lngUserID = rsSource!user_id
        strDates = Nz(rsSource!DateList, "")
        
        If Len(strDates) > 0 Then
            arrDates = Split(strDates, " | ")
            For i = LBound(arrDates) To UBound(arrDates)
                If IsDate(arrDates(i)) Then
                    rsTemp.AddNew
                    rsTemp!user_id = lngUserID
                    rsTemp!SingleDate = CDate(arrDates(i))
                    rsTemp.Update
                End If
            Next i
        End If
        rsSource.MoveNext
    Loop

    rsSource.Close
    Set rsSource = Nothing
    Set db = Nothing

    If Not rsTemp.EOF Then rsTemp.MoveFirst
    Set GetSplitDatesRecordset = rsTemp
End Function

Public Sub LoadDatesIntoForm(frm As Object)
    Dim rs As Object
    Set rs = GetSplitDatesRecordset()

    If rs.EOF Then
        MsgBox "لا توجد تواريخ!", vbExclamation
        Exit Sub
    End If
    
    If TypeOf frm Is Form Then
        Set frm.Recordset = rs
    ElseIf TypeOf frm Is Access.SubForm Then
        Set frm.Form.Recordset = rs
    End If
End Sub


Public Sub LoadDatesIntoListBox(frm As Form, strListBoxName As String)
    Dim rs As Object
    Dim strRowSource As String
    Dim ctl As Control
    
    Set ctl = frm.Controls(strListBoxName)
    Set rs = GetSplitDatesRecordset()

    If rs.EOF Then
        ctl.RowSource = ""
        Exit Sub
    End If

    Do Until rs.EOF
        strRowSource = strRowSource & rs!user_id & ";" & Format(rs!SingleDate, "yyyy-mm-dd") & ";"
        rs.MoveNext
    Loop

    ctl.RowSourceType = "Value List"
    ctl.ColumnCount = 2
    ctl.ColumnWidths = "2cm;3cm"
    ctl.RowSource = strRowSource
End Sub

ولكن تعتمد على احدى الحيلتين
الاولة نموذج مستمر غير منضم به حقلين
الاول  : txtuserId   
الثانى: txtSingleDate  
وعند تحمل النموذج نستخدم الاستدعاء التالى 

 

Private Sub Form_Load()
    Me.txtuserId.ControlSource = "user_id"
    Me.txtSingleDate.ControlSource = "SingleDate"
    LoadDatesIntoForm Me
End Sub



الحيلة الثانية نموذج غير منضم به مربع قيم مثلا باسم : lstDates
وعند تحمل النموذج نستخدم الاستدعاء التالى 

 

Private Sub Form_Load()
    LoadDatesIntoListBox Me, "lstDates"
End Sub



هذا كل ما خطر على بالى من افكار 


 

قام بنشر
6 ساعات مضت, ابوخليل said:

السلام عليكم

 

وعليكم السلام ورحمة الله وبركاته ..

على سبيل اني فهمت الفكرة ، هل هذه النتيجة المطلوبة ؟؟

 
المعرف dateField
11 2025-07-02
11 2025-07-03
11 2025-07-04
11 2025-07-05
22 2025-07-04

 

كما في مشاركة أستاذي @ابو جودي ؟؟

2 ساعات مضت, ابو جودي said:
SELECT tbl1.user_id, tbl2.dateField
FROM tbl1, tbl2
WHERE (((tbl2.dateField) Between [tbl1].[startA] And [tbl1].[endA]))
ORDER BY tbl1.user_id, tbl2.dateField;

 

قام بنشر

طيب استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل :fff:

يبدو ان الفكرة هذه تخص
تسجيل اجازة او مأمورية او تدريب او شئ من هذا القبيل بين فترين

أولا انا حاولت وضع كل الاجابات وكل ما خطر بالى فيما يخص السؤال والموضوع بقدر الامكان حسب فهمى المتواضع

 

ولكن ولكن لكن 

وبناء على تجارب عملية

الافضل هو تسجيل التواريخ جميعا من خلال لوب بداية من اول تاريخ الى اخر تاريخ فى الجدول المخصص من البداية على هيئة سجلات

 

الميزة والافضلية

اولا لاى سبب عارض اى تغيير فى المستقبل بين الفترات يسهل حذفه ونهيك عن  سهولة تطبيق باقى العمليات والاجراءات التى تخطر على بالك فى الوقت الراهن والتى فى النهاية جعلتك تحاول تفكيك التواريخ الى سجلات

لنعطى مثال صغير وهذا طبقته بشكل عملى فى مؤسستى 

لنفترض ان موظف ما قدم طلب اجازة اعتيادية مثلا من يوم 1/7/2025 وحتى 10/7/2025
تتم عملية التسجيل لكل تاريخ سجل بكود الموظف والتاريخ ونوع اليومية مع استبعاد ايام العطلات من اللوب سواء كانت رسمية او غير رسمية

الميزة هنا : ععد السجلات لهذا الموظف وحسب نوع اليومية هو اجمالى ما حصل الموظف عليه او سوف يحصل عليه ان كانت فى تواريخ مستقبلية
طيب لنفترض ان عدد السجلات كان 7  اذا هو سمثل 7 ايام ب 7 تواريخ من تاريخ البدء وحتى تاريخ الانتها

طيب لفترض ان الموظف اخذ فقط يومين وقطع الاجازة وعاد الى العمل ولم يخبر المختص لاعادة التعديل لضبط الرصيد

انا عامل استعلام يبدأ مع فتح نموذج التسجيل يطابق هذا الجدول مع جدول الحضور الخاص بالبصمة ووفق التواريخ التى لها بصمة حضور وتساوت مع تواريح فى جدول اليوميات مثلا على انها اجازة يتم حذفها تلقائيا من جدول الاجازات

بذلك يتم تصحيح الرصيد بشكل الى وبدون تدخل بشرى :wink2:

اعتقد فرد التواريخ من البداية ليكون كل تاريخ فى سجل له الافضلية ويضفى المرونة القصوى اثناء معالجة البيانات ويلبى العديد من الرغبات بشتى الافكار 
 

قام بنشر

 

3 ساعات مضت, ابوخليل said:

يمكن كلمة " العرض في حقل واحد "  التي في العنوان عملت لبس في فهم المطلوب .. سوف اعدلها الى "العرض في قائمة"

وخطر لي حيلة يمكن تكون غريبة نوعاً ما .. وهي كما في الاستعلام التالي :-

SELECT tbl1.id, tbl1.user_id, tbl1.startA, tbl1.endA, IIf(DateDiff("d",[startA],[endA])>=0,Format([startA],"yyyy-mm-dd"),"") & IIf(DateDiff("d",[startA],[endA])>=1,"," & Format([startA]+1,"yyyy-mm-dd"),"") & IIf(DateDiff("d",[startA],[endA])>=2,"," & Format([startA]+2,"yyyy-mm-dd"),"") & IIf(DateDiff("d",[startA],[endA])>=3,"," & Format([startA]+3,"yyyy-mm-dd"),"") & IIf(DateDiff("d",[startA],[endA])>=4,"," & Format([startA]+4,"yyyy-mm-dd"),"") AS التواريخ
FROM tbl1;

والنتيجة :-

 

Query3
id المعرف بداية نهاية التواريخ
1 11 2025-07-02 2025-07-05 2025-07-02,2025-07-03,2025-07-04,2025-07-05
2 22 2025-07-04 2025-07-04 2025-07-04

 

طبعاً هنا اذا كان الفرق بين التاريخين كبير فسيكون الاستعلام كبيراً نوعاً ما .. لكني وددت المشاركة 😅 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information