معادلة او كود جلب بيانات بدلالة اسم مكرر

[HussienAlkinani]

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

 

New Microsoft Excel Worksheet.xlsx

تم تعديل مايو 17, 2019 بواسطه HussienAlkinani

[أحمد يوسف]

من فضلك اخى الكريم وضح المطلوب بشكل أفضل وادق على الملف فانا لا افهم ما هو المطلوب ومن اين بالبيانات المطلوبة فالملف لا يحتوى على سوى صفحة واحدة

ملحوظة :

دائما وابدا اجعل عنوان المشاركة دال على ما تريد وليس كما قمت بعمله ,, شباب مساعدة أو ارجو المساعدة او ماشابه هذا .....الخ

فليكن العنوان معادلة جلب بيانات بدلالة اسم

[Ali Mohamed Ali]

السلام عليكم تم تعديل العنوان ليتناسب مع المطلوب

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

بارك الله فيكم -ونرجو توضيح المطلوب بشكل أوضح حتى تتمكن الأساتذة من المساعدة

[HussienAlkinani]

4 دقائق مضت, أحمد يوسف said:

استاذي العزيز مثلا الاسم جاسم خلف عبرة محل الانتساب فق5 كيف يمكنني ان انسخ عنوان لنفس الاسم المكرر والجميع الاسماء المكررة  تحياتي.

 

 

2 دقائق مضت, ali mohamed ali said:

استاذي العزيز مثلا الاسم جاسم خلف عبرة محل الانتساب فق5 كيف يمكنني ان انسخ عنوان لنفس الاسم المكرر والجميع الاسماء المكررة  تحياتي.

 

[أحمد يوسف]

هل تريد العمل على العمود الرابع  D ؟

ومن اين اتى بالبيانات المطلوب استخراجها -هل هناك صفحة اخرى بها كل بيانات الأسماء ؟ 

[HussienAlkinani]

13 دقائق مضت, أحمد يوسف said:

نعم استاذ احمد العمل على العمود الرابع d فقط نسخ المكرر مثلا فق5 تنسخ على نفس الاسم المكرر 

 

 

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

جرب هذا الماكرو

Sub SALIM_MACRO()
On Error Resume Next

    Columns("D:D").SpecialCells(4) _
    .FormulaR1C1 = "=R[-1]C" '4 =====> xlCellTypeBlanks
  On Error GoTo 0
End Sub

 

[Ali Mohamed Ali]

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

ولكن عند تجربة الكود يأتى بالبيانات صحيحة فى حالة تتابع الأسماء المكررة

ولكن اذا كانت الأسماء المكررة متباعدة ومتفرقة فيأتى ببيانات خاطئة 

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

5 دقائق مضت, Ali Mohamed Ali said:

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

ولكن عند تجربة الكود يأتى بالبيانات صحيحة فى حالة تتابع الأسماء المكررة

ولكن اذا كانت الأسماء المكررة متباعدة ومتفرقة فيأتى ببيانات خاطئة 

من أول نظرة الى الملف لاجظت ان تتابع الأسماء المكررة لذلك اقترحت هذا الماكرو

اذا لم تكن الأسماء المكررة متتابعة بجب اولا ترتيبها (Sort) ابجدياً ثم ينفذ الماكرو

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

يمكن تعبئة الخلايا الفارغة بدون  (Sort) ابجدياً بواسطة هذا الماكرو

Option Explicit
Sub give_Data()
    With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
    End With
Dim last_ro#
last_ro = Range("a1").CurrentRegion.Rows.Count
 Range("MM2").Resize(last_ro - 1).Formula = _
"=IF(AND(C2<>"""",D2<>""""),D2,INDEX($D$2:$D$" & last_ro & ",MATCH(C2,$C$2:$C$" & last_ro & ",0))" & ")"
 
 Range("D2").Resize(last_ro - 1).Value = _
 Range("MM2").Resize(last_ro - 1).Value
 
 Range("MM2").Resize(last_ro - 1) = vbNullString
    With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
    End With
End Sub

الملف مرفق

 

FiLL_Empty.xlsm

[احمد بدره]

تسلم الأنامل

[HussienAlkinani]

10 دقائق مضت, سليم حاصبيا said:

يمكن تعبئة الخلايا الفارغة بدون  (Sort) ابجدياً بواسطة هذا الماكرو

Option Explicit
Sub give_Data()
    With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
    End With
Dim last_ro#
last_ro = Range("a1").CurrentRegion.Rows.Count
 Range("MM2").Resize(last_ro - 1).Formula = _
"=IF(AND(C2<>"""",D2<>""""),D2,INDEX($D$2:$D$" & last_ro & ",MATCH(C2,$C$2:$C$" & last_ro & ",0))" & ")"
 
 Range("D2").Resize(last_ro - 1).Value = _
 Range("MM2").Resize(last_ro - 1).Value
 
 Range("MM2").Resize(last_ro - 1) = vbNullString
    With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
    End With
End Sub

الحقيقة استاذ ماعرف شلون اشكرك ربي يوفقك 

 

FiLL_Empty.xlsm 17.5 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 1 download

 

[وجيه شرف الدين]

الله عليك استاذ سليم عمل رائع جزاكم الله خير الجزاء