• 0
mrnooo2000

حذف السجلات المكررة من الجدول

سؤال

اليكم اخوانى

هذه الهدية المتواضعة

و هى عبارة عن كود لحذف السجلات المكررة بالجدول بدون اى مجهود

فقط نستدعى الكود ليقوم بعمل اللازم

و قد وضعت الكود فى وحدة نمطية لاستدعائها من اى نموذج

و الكود يقارن الحقول بكل سجل ( مع استبعاد حقول الترقيم التلقائى ان وجدت )

و يحذف السجل اذا تطابقت جميع الحقول

وضعت الشرح بالكود

طريقة الاستخدام

1- افتح وحدة نمطية جديدة و ضع بها هذا الكود

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

2- احفظ الوحدة النمطية بأى اسم

3- ضع هذا الكود فى زر حذف المكررات بالنموذج

DeleteDuplicateRecords ("t1")

حيث t1 هو اسم الجدول المراد حذف المكررات منه

اتمنى ان يستفيد منه الجميع و الله الموفق

لا تنسونا من صالح دعائكم

MrNo_delete_repeated.rar

1

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

23 إجابة على هذا السؤال .

  • 0

جزاك الله كل خير أخى

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

و جزاكم مثله

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

مشكور وبارك الله فيك

عمل جميل

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

بارك الله فيك وجزاك الله اخي ابو يوسف

مثال رائع جدا

وفقك الله ونفع بعلمك

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

مثال رائع ومهم..

بارك الله فيك وتسلم ايديك

خبيرنا واستاذنا ابو يوسف

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

بسم الله الرحمن الرحيم

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

كل عام وانتم بخير

اولا مبروووووووووووك لااستاذنا القدير ابو يوسف وانت يستحق هذا اللقب بكل جداره

ثانيا مثال في قمتة الروعه وذا من عادات استاذنا الي يتحفنا بالامثله الجميله

ملاحظتي على الوحده النمطيه انها لاتعمل عند النسخ في الجدول مثال

لدي 200 معامله مثلا قمت بنسخها ولصقها لكي تكون مكرره بالجدول وعند تنفيذ الامر لايتم حذفها

ارجو ان تقوم بالتجربه على اكثر من مثال

اعلم جيداً ان لديك الحل ولكن الكثير من الاعضاء يرغبون به

وتقبل مروري بسعة صدر

اختكم روان

تم تعديل بواسطه roan27
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

اخى مالك

اخى at_aziz

اخى همام

اشكركم و جزاكم الله خيرا

اختنا روان

فينك مختفيه منذ زمن محدش بيشوفك

لا حرمنا الله من ملاحظاتك

فعلا كلامك فى محله

سأجرب و اخبرك

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

شكرك اخت روان على التنبيه

لكن المشكله ليست فى النسخ

المشكله فى ترتيب سجلات الجدول

و الحل هو تعديل السطر المسئول عن الترتيب فى الوحدة النمطية

   If (fld.Type <> dbMemo) And (fld.Type <> dbLongBinary And IsAutoNumber(fld) = False) The

n

تم التعديل بالمرفق

MrNo_delete_repeated.rar

2

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

دائماً مبدع استاذ أبو يوسف .. بارك الله فيك..

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

السلام عليكم

اجابه موفقه اخي ابو يوسف

والحمد لله انا عارفه الاجابه ولكن تكون منك افضل واجمل

ولكن هناك طلب اخر قد يرغبه بعض الاعضاء او الزوار

وهو

الحذف بالتشابه بحقل واحد مثلا الحقل English بغض النظر عن التشابه في بقية الحقول

حتى يكون المثال يلبي كافة الاحتياجات ل الزائر او العضو

1

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

فكرة جميلة اخت روان و ان شاء الله غدا اعطيك الجواب و زياده

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

اخوانى الكرام

بناءا على طلب أختنا روان

بحذف المكررات فى حقل واحد فقط

فقد تم التعديل على الكود بحيث

يمكن مقارنة جميع حقول السجل اذا لم نحدد حقل للمقارنة

و يتم مقارنة حقول حقل واحد و هو الذى يتم تحديده

و كل عام و انتم بخير

MrNo_delete_repeated.rar

تم تعديل بواسطه mrnooo2000
4

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

جزاكم الله خير وجعله الله فى ميزان حسناتك

تمنياتى لكم بالتوفيق

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

السلام عليكم

بارك الله فيك استاذانا القدير

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

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

الاخ الكريم Abo_Yossof

+1

انت عبقري بمعنى الكلمة

تسألني ليه ؟ اجاوبك على طول وبدون تأخير

لاني وبدون مبالغة كلما بحثت عن اجابة في بعض الامور اجدك سباق في اصعب الاجابات

كما لاحظت كثيرا بانك محترف في التعامل مع اكواد sql ان صح التعبير

فهنيئا لك بهذا العلم

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

--------------

الاخت الغالية روان

+1

انتي رائعه بكل ماتعنية الكلمة

سواء بمعلوماتك او بنكهة مناقشاتك التي تجعل من المواضيع التي تشاركين بها طعم اخر

------------

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

تحياتي القلبية للجميع

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

بارك الله فيك أستاذنا أبو يوسف... زادك الله علما

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

احسنت ياأخانا ابو يوسف

وفقك الله وأعطاك مرادك في الدنيا والآخرة .

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

السلام عليكم

رجاءا اخي لكن اين اضيف الكود زر حذف المكررات في اي مكان بالظبط؟؟

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

اخى بارك الله فيك وفى امثالك

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

اخى ابو يوسف

قمت باستعمال الوحده النمطيه وهى تعمل بشكل ممتاز

ولكن فى حال استخدامها على مستوى حقل واحد لم تظبط معى

وضعت الكود التالى حيث ZMonthe حقل تاريخ

DeleteDuplicateRecords "TEkharka", "ZMonthe"

فما هو الخطأ

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

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

اريده ان يحذف السجلات اللتى تتكرر بعد الصرف مثل الموجوده حاليا بجدول TEkharka وارقامهم 110 و 210 و 310 واللتى تحمل تاشيرة لم يتم الصرف

الحمد لله توصلت للحل بدون اضافة شىء للكود

وانما اضافة كود لاستعلام الالحاق

Not In (select  kod from TEkharka where kod=kod)

والمرفق بعد التعديل

Za_TestNum.rar

تم تعديل بواسطه طالب علم مبتدىء
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

قد يكون سؤالي تافهه قياسا بخبرتكم ومعلوماتكم ولكني مبتدئه بهذا العلم واريد التعليم ""فتحملوني"

اين اضع كود زر الحذف؟؟؟؟؟؟؟؟؟

رجااااااااء ارجوا الأجابة والتوضيح المفصل

قد سألت هذا السؤال مسبقا في نفس الموضوع ولم اجد الأجابة

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

قد يكون سؤالي تافهه قياسا بخبرتكم ومعلوماتكم ولكني مبتدئه بهذا العلم واريد التعليم ""فتحملوني"

اين اضع كود زر الحذف؟؟؟؟؟؟؟؟؟

رجااااااااء ارجوا الأجابة والتوضيح المفصل

قد سألت هذا السؤال مسبقا في نفس الموضوع ولم اجد الأجابة

حملى المرفق فى المشاركه رقم 13 وافتحى النموذج فى وضع التصميم ثم قفى على اى زر من الاتنين واضغطى f4 واختار تبويب الاحداث هتلاقى حدث عند النقر لما تركزى عليه هيظهر زر صغير اضغطى عليه هيفتح محرر الاكواد معاكى شوفى الكود وان شاء الله توصلى للمطلوب

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

حملى المرفق فى المشاركه رقم 13 وافتحى النموذج فى وضع التصميم ثم قفى على اى زر من الاتنين واضغطى f4 واختار تبويب الاحداث هتلاقى حدث عند النقر لما تركزى عليه هيظهر زر صغير اضغطى عليه هيفتح محرر الاكواد معاكى شوفى الكود وان شاء الله توصلى للمطلوب

[/quoشكرا لسعة صدرك واهتمامك واجابتك الواضحة سأجرب ماقلت

شكرا لسعة صدرك واهتمامك واجابتك الواضحة سأجرب ماقلت

-1

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان

  • يستعرض القسم حالياً   0 members

    لا يوجد أعضاء مسجلين يشاهدون هذه الصفحة .