خطأ فى كود حذف الصفوف

[إبراهيم ابوليله]

الاخوه الكرام

لدى كود يقوم بحزف الصفوف

بناء على تطابق الاسم

الموجود فى الخليه B1

مع الاسماء الموجوده فى العمود الاول بدايه من اللخليه A4

ولكن الخطأ

انه عند الحزف يحزف الاسماء المتطابقه ما عدا اول اسم

ارجو تصحيح الكود ان امكن

DEL.rar

[سليم حاصبيا]

السلام عليكم 

تفضل استاذ ابراهيم /الحل بسيط جداً

مرفق التصحيح

DEL 1.rar

[إبراهيم ابوليله]

السلام عليكم 

تفضل استاذ ابراهيم /الحل بسيط جداً

مرفق التصحيح

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

اخى سليم

مشكورا على الرد

ولكن ما فائدة السطر

i=3

[سليم حاصبيا]

ممكن ان تضعها 4 ليس هنا مشكلة

هذا في حال حذف اي سطر ،يعود الكود ليفتش في كل الصفوف من جديد

جرب ان تضع مباشرة بعد عبارة  i=4

last=last-1 

ممكن ان ذلك يسرع العملية بحيث ينقص عدد الصفوف /اذا حصل مشكلة
يمكن حذف هذا الشيء

[إبراهيم ابوليله]

اخى سليم

بارك الله فيك

ومشكورا على المعلومه الجميله دى

شكرا لك

[AL_AYMAN]

اخى الكريم

الاستاذ سليم

الكود اكثر من رائع وجزاك الله كل الخير

ولكن  يستغرق وقت طويل جدا لاننى اقوم بتفعيلة على ورقة عمل بها حوالى 100,000 صف 

هل هناك طريقة لتسريع  عملية الخذف ومع اننى وضعت  last=last-1  بعد i=4

وشكرا

[سليم حاصبيا]

استاذ ابرهيم

جرب ان تضع شرطاً انه في حال كان  last  اكبر من 99950 فإن  i تبقى كما هي

و ارجغ قيمة   i =4  لتبدأ عملها في اخر  50 اسم

                                                                       والله أعلم

[AL_AYMAN]

استاذ ابرهيم

جرب ان تضع شرطاً انه في حال كان  last  اكبر من 99950 فإن  i تبقى كما هي

و ارجغ قيمة   i =4  لتبدأ عملها في اخر  50 اسم

                                                                       والله أعلم

اخى الكريم

ممكن حضرتك تضيف الشرط فى الكود لاننى لن استطيع اضافتة 

وشكرا

[عبدالله باقشير]

السلام عليكم

 

الحل السليم ان يتم معالجة البيانات من الاسفل الى الاعلى

 

هكذا :

For i = Last To 3 Step -1

وهذا كود الحذف

Sub DELETE_ROWS()
Dim Last As Long, i As Long
With Sheet1
    Last = .Cells(Rows.Count, "A").End(xlUp).Row
    For i = Last To 3 Step -1
        If .Cells(i, 1) = Range("B1").Value Then
            .Cells(i, "A").Resize(1, 3).Delete Shift:=xlUp
        End If
    Next
End With
End Sub

واذا كانت البيانات كبيرة

يفضل تجميع الخلايا (التي تريد حذفها حسب الشرط ) في متغير من النوع Range

اثناء دوران السلسلة

 

وبعد الانتهاء من دوران السلسلة

يتم حذف الخلايا المجمعة في المتغير مرة واحدة

 

وهذا مثال لذلك

Sub kh_RngDelete()
Dim RngDelete As Range
Dim Last As Long, i As Long
With Sheet1
    Last = .Cells(Rows.Count, "A").End(xlUp).Row
    For i = 3 To Last
        If .Cells(i, 1) = Range("B1").Value Then
            If RngDelete Is Nothing Then Set RngDelete = .Cells(i, "A").Resize(1, 3) _
            Else Set RngDelete = Union(RngDelete, .Cells(i, "A").Resize(1, 3))
        End If
    Next
End With
If Not RngDelete Is Nothing Then RngDelete.Delete xlUp
End Sub

تحياتي

[سليم حاصبيا]

استاذي الكريم عبدالله

ممكن ان ترسل الكود من فضلك للطريقة الثانية.

سؤال آخر: هل من الضروري ان يكون  (resize (1,3   

اقصد ممكن يكون اكبر؟                                           تلميذكم  سليم

                                                                           الشكر سلفاً

[عبدالله باقشير]

استاذي الكريم عبدالله

ممكن ان ترسل الكود من فضلك للطريقة الثانية.

سؤال آخر: هل من الضروري ان يكون  (resize (1,3   

اقصد ممكن يكون اكبر؟                                           تلميذكم  سليم

                                                                           الشكر سلفاً

 

انسخ الكود الى ملفك المرسل في المشاركة 2

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

 

تحياتي

[إبراهيم ابوليله]

اخى عبدالله

مشكورا على المعلومات لجميله

بارك الله فيك