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

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


omarahmed1424

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

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

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

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

 

رابط هذا التعليق
شارك

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

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

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

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

رابط هذا التعليق
شارك

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

 

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

 

اخوي عمر :

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

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

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

 

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

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

 

جعفر

  • Like 1
رابط هذا التعليق
شارك

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

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

 

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

 

جعفر

 

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

  • 2 years later...

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