اذهب الي المحتوي
أوفيسنا

اريد كود استخرج الاسماء الجديده

إبراهيم ابوليله
 مشاركة

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

طارق محمود

طارق محمود

قام بنشر
قام بنشر

السلام عليكم

أخي الكريم

تفضل الكود التالي


Sub chooose()

5 LR = [D1000].End(xlUp).Row

For Each ce In [A4:A150]

    If ce.Value = "" Then GoTo 10

    For r = 4 To LR

        If ce.Value = Cells(r, "D").Value Then GoTo 10

    Next r

    Cells(LR + 1, "D").Value = ce.Value: GoTo 5

10 Next ce

End Sub

طارق محمود

طارق محمود

قام بنشر
قام بنشر

الاخ طارق بارك الله فيك

ماذا لو اردنا استخراج الاسماء بدون زر

السلام عليكم

هذا هو الكود في حدث الورقة


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 1 Then Exit Sub

Range("D1:D" & [D10000].End(xlUp).Row).ClearContents

[D3] = " "

5 LR = [D1000].End(xlUp).Row

For Each ce In [A4:A150]

If ce.Value = "" Then GoTo 10

For r = 4 To LR

If ce.Value = Cells(r, "D").Value Then GoTo 10

Next r

Cells(LR + 1, "D").Value = ce.Value: GoTo 5

10 Next ce


End Sub

تفضل أخي أيضا المرفق وبه الكود المطلوب

استخراج الاسماء الجديده.rar

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

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

قام بنشر
  • الكاتب
قام بنشر

الاخ طارق بارك الله فيك

وما اجملك حين تشرح

فاننا تعودنا منك على الشرح الوفير الملم بكل المعلومات

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

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

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

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع
×
×
  • اضف...

Important Information

  I accept