خطأ فى كود حدث الورقه

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

الاخوه الافاضل

 

ارجو المساعده فى الخطأ الذى

 

يحدث كما هو موضح بالشيت

error.rar

[ibn_egypt]

اخى الفاضل

 

تفضل الملف المرفق لعله يفي بالمطلوب

 

تحياتي  

error.rar

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

اخى ابن مصر

اشكرك

ولكنى اريد ذلك على الكود الذى قمت انا بارفاقه

لان فى الكود يوجد معادله تقوم باستخراج بيانات

وان عدد السطور التى تعمل المعادله عليها 7000 سطر

لذلك تم استخدام

المتغيرX

وهو الوصول الى اخر سطر به بيانات

تفاديا لطول الوقت فى تنفيذ الكود

ولكن الخطأ الذى حدث هو عدم مسح اخر خليه

لاحظ ان شكل الكود يكون كالاتى

Private Sub Worksheet_Change(ByVal Target As Range)
x = [f7000].End(xlUp).Row
If Not Intersect(Target, Range("f4:f" & x)) Is Nothing Then
    Application.ScreenUpdating = False
    If Target.Value = Empty Then Target.Offset(0, 1) = "": Exit Sub
      '  [m4].FormulaR1C1 = _
      "=IF(RC[-7]<>"""",IF(MAX(INDEX((R4C6:RC[-7]=RC[-7])*(R4C1:RC[-12]=RC[-12])*(R4C14:RC[1]),0))=0,"""",MAX(INDEX((R4C6:RC[-7]=RC[-7])*(R4C1:RC[-12]=RC[-12])*(R4C14:RC[1]),0))),"""")"
'[m4].AutoFill Destination:=Range("m4:m" & x), Type:=xlFillDefault
'Range("m4:m" & x) = Range("m4:m" & x).Value
'For Each cl In Sheets("ÈíÇäÇÊ").[A2:A100]
'If cl = Target Then Target.Offset(0, 1) = cl.Offset(0, 1): Exit Sub
'Next
Application.ScreenUpdating = True
End If

End Sub

وبذلك اذا قمنا بتغير هذا السطر

If Not Intersect(Target, Range("f4:f" & x)) Is Nothing Then

الى

If Not Intersect(Target, Range("f4:f7000")) Is Nothing Then

ستجد ان عمليه المسح تتم بنجاح

ولكن تطول فتره تنفيذ الكود

فهل هناك فكره لتفادى هذا الخطأ

مع الاستمرار فى استخدام تحديد النطاق

من

Range("f4:f" & x

[ibn_egypt]

اخى الفاضل أ.إبراهيم

 

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

x = [f7000].End(xlUp).Row + 1

تحياتي  

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

اشكرك اخى ابن مصر

بالفعل ظبطت

ولكن اصبح الكود يضع الرقم 0 فى الخليه التى

تلى الخليه النشطه التى يتم العمل عليها

على العموم

تم حل المشكله

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

تقبل تحياتى