ارجو مساعدتكم في ربط معلومات ملفين آكسل

[نوف]

السلام عليكم

 

أعتذر اذا كان موضوعي الاول عباره عن سؤال ولكن تعبت من البحث وارجو منكم مساعدتي

 

انا موظفة في شركه فيها اكثر من 5000 موظف وموظفه وعندي بيانات الموظفين بعدد كبير وابي اجمع بياناتهم للتدقيق فيها في ملف واحد دون تكرار

 

يعني عندي ملف بهذا الشكل

 

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

 

ارجو مساعدتكم وشكرا

[خالد الرشيدى]

السلام عليكم

ا. نوف

حضرتك لم تدرجي الملفات للعمل عليها

ومع ذلك الامر بسيط يمكن ببساطه نسخ قيم ملف ولصقها بداخل الاخر

اما وعن حذف المتكرر

حددي عمود الرقم الوظيفي بالكامل ثم من قائمه home اختاري conditional formatting. ثم من highlight cells rules. اختاري duplicate values ثم ok. 

عندها ان كان هناك من متكرر سيظهر بتعبئه حمراء ويمكنك عندها تحديدها وحذفها

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

 

[نوف]

شكرا لردك استاذ خالد

 

اعرف انا القيم المتكرره 

 

لكن انا عندي ملفين وكلهم فيهم الرقم الوظيفي لكل الموظفين ولكن مواقع الارقام الوظيفيه تختلف والاسماء احيانا تختلف حسب المدخل وباقي البيانات تختلف في كل ملف وابي ادمج جميع معلوماتهم في ملف واحد من دون ان اخسر شي عن طريق تشابه الرقم الوظيفي

حاولت اسوي فرز من الاكبر للاصغر لكن تتلخبط عندي البيانات

حاولت افهم دالة vlookup بس ماقدرت اتوصل للطريقه

المشكله ان الموظفين اكثر من 5000 والنسخ واللصق مايغني عن التدقيق واحتمال وجود الاخطاء كبير

 

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

 

مرفق لك استاذي 

 

 

 

 

 

 

 

xlsx.zip

[نوف]

اعتذر عن الرفع ولكن لحاجتي الماسه

[خالد الرشيدى]

السلام عليكم

 ضعي هذا الكود بشيت رقم 1 وراجعي النتائج - عله المطلوب تماماً ( قمت بتنفيذ ذلك بالملف المرفق )

Sub Button1_Click()

    Dim rw As Long, x As Range
    Dim extwbk As Workbook, twb As Workbook

    Set twb = ThisWorkbook

    Set extwbk = Workbooks.Open(ThisWorkbook.Path & "\" & "2.xlsx")
    Set x = extwbk.Sheets("ورقة1").Range("A1:C752")

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .DisplayAlerts = False
        .AskToUpdateLinks = False
    End With

    With twb.Sheets("ورقة1")

        For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            .Cells(rw, 4) = Application.VLookup(.Cells(rw, 1).Value2, x, 3, False)
        Next rw

    End With

    extwbk.Close savechanges:=False

    With Application
        .AskToUpdateLinks = True
        .DisplayAlerts = True
        .Calculation = xlAutomatic
        .ScreenUpdating = True
    End With


End Sub

merge.rar

[نوف]

اشكرك استاذي الغالي واعتذر عن ازعاجك ولكن للاسف لم تفلح الطريقه

 

هل اصدار الاوفيس يتسبب في مشكله حيث اعمل على اوفيس 2013.؟

[خالد الرشيدى]

ليس لاصدار الاوفيس تأثير

ولكن هل الملفين موجودين بمكان واحد علي الكمبيوتر .. وهل اسماءهم 1-2 كما ارسلتهم .. ان كانوا كذلك ولم يتم تنفيذ الكود اذن 

هل الاعمده بالملفين مثل الاعمده بالملفات الاساسية تماماً.. لا يهم عدد الصفوف

ان كانوا كذلك ولم يتم تنفيذ الكود.. عندها ارسلي صوره الخطأ الذي يظهر عند التنفيذ 

 

[ياسر خليل أبو البراء]

السلام عليكم

جربت كود الأخ الحبيب خالد الرشيدي ويعمل بشكل جيد

عموماً قمت بعمل كود في ملف منفصل يقوم بدمج البيانات في كلا الملفين دون فتحهما .. كل ما عليك هو فتح الملف ثم النقر على زر الأمر الموجود ليقوم الكود يدمج البيانات في كلا الملفين

رابط الملف المرفق من هنا