حذف القيم المكررة وترك واحدة فقط

[omarahmed1424]

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

الأخوة الاعزاء أعضاء المنتدى الكرام

في جزء من البرنامج الخاص بمدارسنا يتم تسجيل الغياب للطلاب ولكن ما أعاني منه هو إدخال الغياب لنفس الطالب بنفس الطالب مرتين ولذا أفكر في عمل كود أو أمر لقراءة القيم في الجدول وحذف التكرار وترك الغياب مرة واحدة للطالب الواحد في اليوم الواحد فهل هذا ممكن ؟؟؟

 

[jjafferr]

وعليكم السلام

 

اذكر اخوي @ابوخليل له مشاركة في هذا الخصوص ، وحتى كان اختيار بترك او سجل وحذف الباقي ،

 

جعفر

[ابوخليل]

شكرا استاذنا الغالي للنداء .. بالنسبة لي لا اذكر  وايضا لا يحضرني شيء .. سأبحث في محفوظاتي لعلي اجد شيئا .

[ابوخليل]

هذا رابط تراثي للاستاذ ابي هادي

وهذا الرابط لاستخدام الحذف اليدوي

وهذا مثال تعرفت على صاحبه من الرمز في تسمية المرفق وهو الاستاذ ابو يوسف

Public Sub DeleteDuplicateRecords(strTableName As String)
    ' حذف السجلات المكررة اذا كانت جميع الحقول متطابقة مع استبعاد حقول الترقيم التلقائى من عملية المقارنة
    Dim rst As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim strSQL As String
    Dim varBookmark As Variant
    Dim i As Integer
    i = 0
    
    Set tdf = DBEngine(0)(0).TableDefs(strTableName)
    strSQL = "SELECT * FROM " & strTableName & " ORDER BY "
    ' ترتيب السجلات للتأكد من أن السجلات المكررة تكون متتالية
    'OLE or Memo لن يتم الترتيب على اساس الحقول من نوع
    For Each fld In tdf.Fields
        If (fld.Type <> dbMemo) And (fld.Type <> dbLongBinary) Then
            strSQL = strSQL & fld.Name & ", "
        End If
    Next fld
    '", "  و هى sql حذف العلامات الزائدة فى نهاية جملة ال
    strSQL = Left(strSQL, Len(strSQL) - 2)
    Set tdf = Nothing

    Set rst = CurrentDb.OpenRecordset(strSQL)
    ' نأخذ نسخة من مجموعة السجلات ليتم المقارنة بها
    Set rst2 = rst.Clone
    rst.MoveNext
    Do Until rst.EOF
        varBookmark = rst.Bookmark
        For Each fld In rst.Fields
    ' استبعاد حقول الترقيم التلقائى من عملية المقارنة
            If IsAutoNumber(fld) = False Then
            'اذا كانت قيمة الحقل غير مكررة انتقل الى السجل التالى
            'و اذا كانت مكررة انتقل الى الحقل التالى فى نفس السجل و قارن القيمة
            If fld.Value <> rst2.Fields(fld.Name).Value Then
                GoTo NextRecord
            End If
            End If
        Next fld
        'احذف السجل المكرر
        rst.Delete
        'عدد السجلات المحذوفة
        i = i + 1
        GoTo SkipBookmark
NextRecord:
        rst2.Bookmark = varBookmark
SkipBookmark:
        rst.MoveNext
    Loop
    
    rst2.Close
    Set rst2 = Nothing
    rst.Close
    Set rst = Nothing
    
    MsgBox IIf(i > 0, "تم حذف عدد " & i & " سجلات مكررة", "لا يوجد سجلات مكررة")

End Sub

Function IsAutoNumber(ByRef fld As Object) As Boolean
'لتحديد ما اذا كان نوع الحقل ترقيم تلقائى ام لا
On Error GoTo ErrHandler

  If TypeOf fld Is ADODB.Field Then
    IsAutoNumber = (fld.Properties("ISAUTOINCREMENT") = True)
  ElseIf TypeOf fld Is DAO.Field Then
    IsAutoNumber = (fld.Attributes And dbAutoIncrField)
  Else
    Err.Raise vbObjectError + 100, "IsAutoNumber()", _
      "Unsupported Field Type argument: " & TypeName(fld)
  End If

ExitHere:
  Exit Function
ErrHandler:
  Debug.Print Err, Err.Description
  Resume ExitHere
End Function

 

MrNo_delete_repeated.rar

[jjafferr]

اعتذر منك اخوي ابوخليل ، موضزعك كان يختلف شوي:

 

ولكنك ما شاء الله عندك مخزن يحتوي على كل غالي ونفيس

 

اخوي عمر :

54 دقائق مضت, omarahmed1424 said:

1. ما أعاني منه هو إدخال الغياب لنفس الطالب بنفس الطالب مرتين

2. ولذا أفكر في عمل كود أو أمر لقراءة القيم في الجدول وحذف التكرار وترك الغياب مرة واحدة للطالب الواحد في اليوم الواحد فهل هذا ممكن ؟؟؟

 

1. يجب معالجة هذا الموضوع ، فعليه لن تحتاج الى الحذف ،

2. محتاجين الجدول الذي و به بيانات قليلة ، ومثال على المطلوب.

 

جعفر

[omarahmed1424]

9 ساعات مضت, jjafferr said:

وعليكم السلام

 

اذكر اخوي @ابوخليل له مشاركة في هذا الخصوص ، وحتى كان اختيار بترك او سجل وحذف الباقي ،

 

جعفر

 

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

هذا رابط تراثي للاستاذ ابي هادي

وهذا الرابط لاستخدام الحذف اليدوي

وهذا مثال تعرفت على صاحبه من الرمز في تسمية المرفق وهو الاستاذ ابو يوسف

Public Sub DeleteDuplicateRecords(strTableName As String)
    ' حذف السجلات المكررة اذا كانت جميع الحقول متطابقة مع استبعاد حقول الترقيم التلقائى من عملية المقارنة
    Dim rst As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim strSQL As String
    Dim varBookmark As Variant
    Dim i As Integer
    i = 0
    
    Set tdf = DBEngine(0)(0).TableDefs(strTableName)
    strSQL = "SELECT * FROM " & strTableName & " ORDER BY "
    ' ترتيب السجلات للتأكد من أن السجلات المكررة تكون متتالية
    'OLE or Memo لن يتم الترتيب على اساس الحقول من نوع
    For Each fld In tdf.Fields
        If (fld.Type <> dbMemo) And (fld.Type <> dbLongBinary) Then
            strSQL = strSQL & fld.Name & ", "
        End If
    Next fld
    '", "  و هى sql حذف العلامات الزائدة فى نهاية جملة ال
    strSQL = Left(strSQL, Len(strSQL) - 2)
    Set tdf = Nothing

    Set rst = CurrentDb.OpenRecordset(strSQL)
    ' نأخذ نسخة من مجموعة السجلات ليتم المقارنة بها
    Set rst2 = rst.Clone
    rst.MoveNext
    Do Until rst.EOF
        varBookmark = rst.Bookmark
        For Each fld In rst.Fields
    ' استبعاد حقول الترقيم التلقائى من عملية المقارنة
            If IsAutoNumber(fld) = False Then
            'اذا كانت قيمة الحقل غير مكررة انتقل الى السجل التالى
            'و اذا كانت مكررة انتقل الى الحقل التالى فى نفس السجل و قارن القيمة
            If fld.Value <> rst2.Fields(fld.Name).Value Then
                GoTo NextRecord
            End If
            End If
        Next fld
        'احذف السجل المكرر
        rst.Delete
        'عدد السجلات المحذوفة
        i = i + 1
        GoTo SkipBookmark
NextRecord:
        rst2.Bookmark = varBookmark
SkipBookmark:
        rst.MoveNext
    Loop
    
    rst2.Close
    Set rst2 = Nothing
    rst.Close
    Set rst = Nothing
    
    MsgBox IIf(i > 0, "تم حذف عدد " & i & " سجلات مكررة", "لا يوجد سجلات مكررة")

End Sub

Function IsAutoNumber(ByRef fld As Object) As Boolean
'لتحديد ما اذا كان نوع الحقل ترقيم تلقائى ام لا
On Error GoTo ErrHandler

  If TypeOf fld Is ADODB.Field Then
    IsAutoNumber = (fld.Properties("ISAUTOINCREMENT") = True)
  ElseIf TypeOf fld Is DAO.Field Then
    IsAutoNumber = (fld.Attributes And dbAutoIncrField)
  Else
    Err.Raise vbObjectError + 100, "IsAutoNumber()", _
      "Unsupported Field Type argument: " & TypeName(fld)
  End If

ExitHere:
  Exit Function
ErrHandler:
  Debug.Print Err, Err.Description
  Resume ExitHere
End Function

 

MrNo_delete_repeated.rar

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

أشكر الأعضاء الأساتذة الكبار على بذل المجهود للوصول للهدف والاستجابة السرعة وأعتذر عن عدم البحث في المنتدى العملاق قبل القيام بإدراج موضوع جديد ولكنها العجلة فقد وجدت موضوعا مشابها لما أطلبه على الرابط .

وأكرر للجميع الشكر والتقدير وأنتهز الفرصة لأذكر أخي وحبيبي وأستاذي أ / جعفر بموضوع مسقط التقارير الإصدار الجديد الملبي لطموح الأحباء الشغوفين به .

[aelbehiery]

استخدمت المرفق من الأستاذ ابوخليل said  ولكن عند تغيير أسماء الأعمدة يظهر error  فكيف أحل تلك المشكلة