DR.ZUHAIR قام بنشر أبريل 29, 2013 مشاركة قام بنشر أبريل 29, 2013 الاخوة الكرام السلام عليكم المطلوب : أولاً : كيف يمكن ترحيل البيانات من الصفحة 2 إلى الصفحة 1 بشرط تساوي بيانات العمود G مع العمود G بالورقة 1 أي مثلاً عند FBB-1 في ورقة 2 يتم نقل البيانات إلى FBB-1 في ورقة 1 مع الإبقاء على البيانات الاخرى كما هي ... ( والمقصود بالتساوي هنا هو تساوي كل حالة بذاتها على حدة ) ثانياً: عمل متوالية تتزايد برقم 1 كل 6 خطوات في الورقة رقم 1 أي FBB-3 ، FBB-2 ، FBB-1 ... وهكذا على أن تتكرر FBB- عدد 6 مرات وجزاكم الله عنا كل خير FBB.zip رابط هذا التعليق شارك More sharing options...
DR.ZUHAIR قام بنشر أبريل 30, 2013 الكاتب مشاركة قام بنشر أبريل 30, 2013 عذراً للرفع رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر أبريل 30, 2013 مشاركة قام بنشر أبريل 30, 2013 السلام عليكم بخصوص المطلوب الاول ماهو معيار الترحيل (لان الموجود غير مفهوم) === بخصوص المطلوب الثاني تم عمل دالة لعمل المتوالية المطلوبة شاهد المرفق FBB.zip رابط هذا التعليق شارك More sharing options...
DR.ZUHAIR قام بنشر أبريل 30, 2013 الكاتب مشاركة قام بنشر أبريل 30, 2013 (معدل) السلام عليكم ورحمة الله وبركاته أستاذنا الفاضل عبدالله جزاك الله عنا كل الخير وجعله في ميزان حسناتك .... المطلوب الثاني قمت بإنجازه على أكمل وجه فبارك الله لنا فيك ... أما عن المطلوب الأول فأنا أعتذر إن لم يكن سؤالي واضح ... وهو ببساطة أريد كود يقوم بترحيل قيم الخلايا على أن يكون الشرط كالتالي : المدى من G2:G7 بالصفحة رقم 2 يساوي X حيث X هي قيم الخلايا المساوية له في العمود G بالصفحة رقم 1 عندها يتم ترحيل قيم الخلايا بالأعمدة 1 إلى 6 بالصفحة 2 إلى الصفحة رقم 1 (وبشرط عدم مسح البيانات المؤرشفة في صفحة رقم 1 ولكن نسخ البيانات الجزء الموجود بالمدى G2:G7 من الصفحة 2 إلى ما يقابلها بالصفحة رقم 1) مثال : FBB-3 في الصفحة 2 = FBB-3 في الصفحة 1 عندها يتم ترحيل البيانات إلى الصفحة رقم 1 مرفق ملف لشرح المطلوب FBB2.zip تم تعديل أبريل 30, 2013 بواسطه DR.ZUHAIR رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر أبريل 30, 2013 مشاركة قام بنشر أبريل 30, 2013 السلام عليكم ضع هذا الكود في زر أمر في الورقة 2 Sub Abu_Ahmed() Dim cl As Range Set Mysh = Sheets("1") For Each cl In Mysh.Range("G2:G" & Mysh.[G10000].End(xlUp).Row) If cl = [G2] Then Mysh.Range("A" & cl.Row & ":" & "F" & cl.Row + 5).Copy Range("A2").PasteSpecial xlPasteValues Exit For End If Next Set Mysh = Nothing End Sub 1 رابط هذا التعليق شارك More sharing options...
DR.ZUHAIR قام بنشر أبريل 30, 2013 الكاتب مشاركة قام بنشر أبريل 30, 2013 (معدل) أخي عبدالله السلام عليكم وفتح الله عليك وزادك من علمه وكرمه لكن أخي الفاضل المطلوب هو ما قمت به تماماً ولكن بالعكس نقل البيانات من ورقة 2 إلى ورقة 1.... وأنا جد متأسف لأنني أرهقتك ... فجزاك الله عنا كل خير تم تعديل أبريل 30, 2013 بواسطه DR.ZUHAIR رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر أبريل 30, 2013 مشاركة قام بنشر أبريل 30, 2013 السلام عليكم (وبشرط عدم مسح البيانات المؤرشفة في صفحة رقم 1 هل ممكن توضيح لهذه الجزئية رابط هذا التعليق شارك More sharing options...
DR.ZUHAIR قام بنشر أبريل 30, 2013 الكاتب مشاركة قام بنشر أبريل 30, 2013 (معدل) (وبشرط عدم مسح البيانات المؤرشفة في صفحة رقم 1 ================================== المقصود أخي الفاضل الابقاء عليها كما هي أي عدم مسحها فهي الورقة التي ستستقبل البيانات وتستحدث البيانات التي تتساوى فيها القيم بالعمود G بالورقة 1 مع الخلية G2 بالورقة 2 ================================= أخي المطلوب هو ما قمت به تماماً ولكن العكس صحيح فقط ============================================== أي أن نقل المجال A2:F7 من الورقة 2 إلى ورقة رقم 1 بشرط تساوي قيمة الخلية G2 بالورقة 2 مع القيم بالعمود G بورقة رقم 1 مرفق ملف + فيديو للتوضيح ولك كل المودة والتقدير FBB3.zip تم تعديل أبريل 30, 2013 بواسطه DR.ZUHAIR رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر أبريل 30, 2013 مشاركة قام بنشر أبريل 30, 2013 السلام عليكم اذاً استبدل الكود السابق بهذا Sub Abu_Ahmed() Dim cl As Range Set Mysh = Sheets("2") For Each cl In Range("G2:G" & [G10000].End(xlUp).Row) If cl = Mysh.[G2] Then Mysh.Range("A2:F7").Copy Range("A" & cl.Row).PasteSpecial xlPasteValues Exit For End If Next Application.CutCopyMode = False Set Mysh = Nothing End Sub ولكن ضع زر الأمر في الورقة 1 رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر أبريل 30, 2013 مشاركة قام بنشر أبريل 30, 2013 وبهذه الصسغة ممكن وضع زر الأمر في اي ورقة Sub Abu_Ahmed() Dim cl As Range Set Mysh = Sheets("2") Set Mysh1 = Sheets("1") For Each cl In Mysh1.Range("G2:G" & Mysh1.[G10000].End(xlUp).Row) If cl = Mysh.[G2] Then Mysh.Range("A2:F7").Copy Mysh1.Range("A" & cl.Row).PasteSpecial xlPasteValues Exit For End If Next Application.CutCopyMode = False Set Mysh = Nothing Set Mysh1 = Nothing End Sub 1 رابط هذا التعليق شارك More sharing options...
DR.ZUHAIR قام بنشر مايو 1, 2013 الكاتب مشاركة قام بنشر مايو 1, 2013 الأخ الفاضل عبدالله المجرب السلام عليكم جزاك الله عنا كل الخير وفتح الله عليكم ... الكود المرفق منكم أنجز العمل بنجاح فبارك الله فيك ... وأعذرني لتأخري في الرد وأثناء تجوالي في أرشيف المنتدى قبل أن أتحصل على الكود المرفق منكم وجدت كود مشابه لما أطلبه وهو من عمل الأخ الفاضل : هادى محمد المامون سالم على هذا الرابط : http://www.officena.net/ib/index.php?showtopic=15490 إلا أن الأمر أحتاج مني لتعديل في الكود ومعادلة التسلسل حتى يتناسب مع طلبي لذا إسمح لي بعد إذنك بنقله حتى تعم الفائدة على الجميع : Sub ZUHAIR() Dim i, ii As Integer For ii = 2 To 7 For i = 2 To 200 If Sheets("2").Cells(ii, 7) = Sheets("1").Cells(i, 7) Then Sheets("1").Cells(i, 7).Offset(0, -6) = Sheets("2").Cells(ii, 1) Sheets("1").Cells(i, 7).Offset(0, -5) = Sheets("2").Cells(ii, 2) Sheets("1").Cells(i, 7).Offset(0, -4) = Sheets("2").Cells(ii, 3) Sheets("1").Cells(i, 7).Offset(0, -3) = Sheets("2").Cells(ii, 4) Sheets("1").Cells(i, 7).Offset(0, -2) = Sheets("2").Cells(ii, 5) Sheets("1").Cells(i, 7).Offset(0, -1) = Sheets("2").Cells(ii, 6) End If Next Next MsgBox "تم الترحيل" End Sub أجدد لكم التحية وجزاكم الله عنا كل خير ... NEW FBB.zip رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان