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

ارجو تعديل الخطا فى الكود


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

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

بعد اذن الاستاذ عبدالله

لتصحيح الخطأ احذف احد السطرين


Range("A6:A10000") = Empty

Range(Cells(R, A), Cells(Range(A & 5000).End(xlUp).Row, A)).ClearContents

بالرغم من ذلك سوف يحدث مشكلة , فالكود سوف يستمر بالعمل دون توقف بسبب ان الكود في حدث الورقة عند التغير والكود يقوم بتغيرات في خلايا في الورقة ولحل مشكلة الكود في حدث الورقة جرب الكود التالي

Private Sub Worksheet_Change(ByVal Target As Range)

Static xxx

If Not Intersect(Target, [A6:B1000]) Is Nothing Then

If xxx = 1 Then Exit Sub

On Error GoTo 10

Application.ScreenUpdating = False

xxx = 1

L = Application.Max([A1000].End(xlUp).Row, [B1000].End(xlUp).Row)

If L < 6 Then GoTo 10

Range(Cells(6, "A"), Cells(L, "A")) = Empty

L = [B1000].End(xlUp).Row

If L < 6 Then GoTo 10

For I = 6 To L

If Cells(I, "A") = "" And Cells(I, "B") <> "" Then

	 N = N + 1

	 For ii = I To [B1000].End(xlUp).Row

		 If Cells(ii, "B") = Cells(I, "B") Then

		 Cells(ii, "A") = N

		 End If

	 Next ii

End If

Next I

10

xxx = 0

Application.ScreenUpdating = True

End If

End Sub

في أمان الله

Copy of STAT-2.rar

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

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.

×
×
  • اضف...

Important Information