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

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

قام بنشر (معدل)

كيف أنقل قيمة كل شخص من الصفحة الأولى إلى الصفحة الثانية مع التنبه إلى أن ترتيب الأشخاص في الصفحة الثانية قد تغير.

الترحيل يكون بماكرو.

 

أنظر المثال في المرفقات

 

وبارك الله في أوقاتكم سلفاً

مشكل تعديل ونقل المعلومات.rar

تم تعديل بواسطه شكيب عمار
قام بنشر

جزاك الباري خير الجزاء، حل طيب.

أيضا أخي الكريم شكر الله لك، كيف يتم ذلك عن طريق ماكرو مع زر ترحيل.

ورزق الله وباقي الإخوة البركة في الوقت

المشكل أخي الكريم في الترحيل وليس استعلام.

وعن طريق الماكرو.

بارك الله فيك.

قام بنشر

هذا هو المطلوب جزاك الله خيرا، وبارك الله فيك وحفظك الله من كل شر ومكروه وسائر الإخوة الذين يسهرون مثلك في هذا المنتدى على مساعدة إخوانهم لوجه الله تعالى.

أرجو شرح الكود أخي الكريم، وكيف لو كان في الصفحة الثانية تعديل كالتالي، وجزاك الله خيرا

مشكل تعديل ونقل المعلومات.rar

قام بنشر (معدل)

الله يعافيك ويبارك فيك، صراحة الحل أفادني كثيرا، جزاكم الله خيرا.

 

ومع ذلك فهناك إضافة أخرى، أريد زيادتها لكي تضبطه أكثر خاصة بعد التجربة والملاحظة، وهي:

1- في حالة إذا لم يجد قيمة تطابق الإسم لا يكتب شيء في الخلية عند الترحيل. لأنه يظهر الخطأ #N/A يضعه في الخلايا التي لا يجد لها قيما مطابقة. (رقم3 في المرفق)

2- أهم شيء في حالة العمل أكثر من مرة، إذا وجد مسبقا شخص غير معني بالترحيل ولديه قيمة قد نقلت سابقا في الصفحة الثانية، فعليه أن يتركها ولا يحذفها، أما الشخص الذي لديه قيمة سترحل حاليا من الصفحة 1 ووجد مسبقا أن لديه قيمة في الصفحة 2 فعليه أن يقوم بتحديثها تلقائيا أو يسأل قبل التحديث. (رقم 4 في المرفق)

 

وغفر الله لكم ولذويكم جميعا.

 Bureau.rar

تم تعديل بواسطه شكيب عمار
قام بنشر

اخى الكريم

بخصوص الطلب الاول استبدل الكود السابق بهذا الكود

Sub Button2_Click()
  Dim lr As Long
     lr = ورقة2.Cells(Rows.Count, "B").End(xlUp).Row
        With ورقة2.Range("D2:D" & lr)
            .FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],ورقة1!R2C2:R1762C3,2,0),"""")"
            .Value = .Value
        End With
End Sub

اما بخصوص الطلب الثانى :- فلم افهم المطلوب ارجوا مزيداً من التوضيح

مع العلم ان طبيعة عمل الكود هو البحث عن القيمة (الورقة 2 ) فى الورقة 1 وارجاع قيمة السطر المجاور لها

  • Like 2
قام بنشر (معدل)

الأخ خالد حفظك الله وزادك والإخوة فضلا وفهما، شكرا لك وبارك الله فيك

جاري تجريب هذا الحل للمشكل الأول.

أما المشكل الثاني، فأنت في العملية كما وضعتها لي، فهي  تقوم بنسخ تلقائي،

يعني: إذا وجد شخص مثلا (عمر) في الصفحة 1 ويوجد في الصفحة 2 ونقلت له قيمته من الصفحة 1 إلى الصفحة 2، بهذا يصبح لديه قيمة عند هذا ترحيل.

فإذا حذفت الشخص (عمر) من القائمة في الصفحة الأولى فأكيد يبقى في الصفحة الثانية مع القيمة التي رحلتها له في الخطوة السابقة،

لكن المشكل بخطوتك فإنه عند ترحيل جديد يحذف القيمة القديمة التي رحلتها لـ (عمر) على أساس أنه لم يجده في الصفحة 1. وأنا أريد القيمة القديمة تبقى لا أن تحذف.

بل وإذا قمت بإعادة (عمر) في قائمة الصفحة الأولى وأعطيت له قيمة أخرى، مع الملاحظة أن (عمر) موجود سلفا في الصفحة 2 فأريد عند ترحيل القيم إما يقوم بتحديث تلقائي لقيمة (عمر) في الصفحة 2 أو يسألني قبل التحديث.

هذا هو الشرح الدقيق غفر الله لك ولوالديك.

Bureau.rar

تم تعديل بواسطه شكيب عمار
قام بنشر (معدل)

استخدم الكود التالى وابدى ملاحظاتك

 Sub Button2_Click()
  Dim lr As Long, cl As Range, n As Integer
     lr = ورقة2.Cells(Rows.Count, "B").End(xlUp).Row
        For Each cl In ورقة2.Range("B2:B" & lr)
          For n = 1 To ورقة1.Cells(Rows.Count, "B").End(xlUp).Row
            If cl.Value = ورقة1.Cells(n, 2) Then
                With cl.Offset(0, 2)
                   .FormulaR1C1 = "=VLOOKUP(RC[-2],ورقة1!R2C2:R1762C3,2,0)"
                   .Value = .Value
                End With
             End If
          Next
        Next
 End Sub

 

تم تعديل بواسطه خالد الرشيدى
  • Like 2
قام بنشر

اخى العزيز خالد الرشيدى جزاك الله خير على هذة المعلومات

ولكن ارجو منك ايجاد حل لمشكلة لدى وهى لدى مثلاً كشف مرتبات بة 200 اسم أو فاتورة بيع بها 200 صنف وذلك فى ملف رفم 1

وارغب فى ترحيل هذة الأسماء أو الأصناف فى ملف اخر  رقم 2 موجود بة بطاقة باسم كل عامل أو كارت الصنف بحيث يتم نقل الصف بالكامل ( 15 او 20 خلية امام كل اسم او صنف ) الذى امام الأسم او الصنف الى الملف الجديد ببطاقة العامل او كارت الصنف مرة واحدة للصف كلة الموجود امام الأسم او الصنف وليس خلية خلية

وشكراً جزيلاً لكم

قام بنشر

اخى الكريم

باسم فاروق.. لم افهم المطلوب جيداً ....قم بارفاق ملف اكسيل موضح فيه طلبك فى موضوع جديد تحت عنوان معبر عن الطلب

وان شاء الله تجد المساعدة ان لم تكن منى ستكون من باقى الاساتذه بالمنتدى

خالص تحياتى

قام بنشر (معدل)

اخى الكريم

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

Sub Button2_Click()
  Dim lr As Long, cl As Range, n As Integer
     lr = ورقة2.Cells(Rows.Count, "B").End(xlUp).Row
        For Each cl In ورقة2.Range("B2:B" & lr)
          For n = 1 To ورقة1.Cells(Rows.Count, "B").End(xlUp).Row
            If cl.Value = ورقة1.Cells(n, 2) Then
                With cl.Offset(0, 2)
                   .FormulaR1C1 = "=VLOOKUP(RC[-2],ورقة1!R2C2:R1762C5,2,0)"
                   .Value = .Value
                End With
                With cl.Offset(0, 4)
                   .FormulaR1C1 = "=VLOOKUP(RC[-4],ورقة1!R2C2:R1762C5,4,0)"
                   .Value = .Value
                End With
             End If
          Next
        Next
 End Sub

 

تم تعديل بواسطه خالد الرشيدى

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.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information