ناصر سعيد قام بنشر مايو 3, 2017 قام بنشر مايو 3, 2017 رائعة النابغه ياسر خليل في الترحيل بالمصفوفات ترحيل أعمدة غير متجاورة لأعمدة غير متجاورة باستخدام المصفوفات (كود حصري)https://youtu.be/ndC28IqkkBw ** من يريد دعمي فليقم بالاشتراك في القناة وعمل لايك للفيديوهات ============= رابط الملف https://www.file-upload.com/ablfo2nqpekx 2
ناصر سعيد قام بنشر مايو 3, 2017 الكاتب قام بنشر مايو 3, 2017 Option Explicit Sub Test() 'متغيرات Dim arr As Variant Dim i As Variant Dim cr As Variant Dim j As Long 'اسم شيت المصدر واسم الخليه الاولى منه arr = Sheets("Sheet1").Range("A3").CurrentRegion.Value 'الأعمدة المطلوب الترحيل إليها cr = Array(3, 5, 9) 'أرقام الأعمدة المطلوب ترحيلها For Each i In Array(2, 6, 10) 'اسم شيت الهدف ورقم صف صفحة الهدف Sheets("Sheet2").Cells(4, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) j = j + 1 Next i End Sub سحر الاكواد 2
ناصر سعيد قام بنشر مايو 4, 2017 الكاتب قام بنشر مايو 4, 2017 لو تكرمت يا استاذ ياسر نريد ان يتم الترحيل بشرط معين في عمود معين ... مثال كلمه ناجح .. ناج*
ياسر خليل أبو البراء قام بنشر مايو 4, 2017 قام بنشر مايو 4, 2017 بارك الله فيك أخي العزيز ناصر بالنسبة لطلبك تم تناوله في فيديو سابق على الرابط التالي (يمكن إضافة شروط أو إضافة علامة النجمة للنص المطلوب كشرط ليكون أعم 1
ناصر سعيد قام بنشر مايو 4, 2017 الكاتب قام بنشر مايو 4, 2017 الترحيل بشرط معين في عمود معين بسهوله ويسر بالمصفوفات للنابغه ياسر خليل Option Explicit 'هذا الكود للمحترم النابغه ياسر خليل 'الهدف من الكود هو ترحيل بشرط 'تم هذا الكود في 15/2/2017 Sub UsingArrays() Dim arr As Variant Dim temp As Variant Dim lr As Long Dim i As Long Dim j As Long Dim c As Long 'متغير اسم ورقة المصدر lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 'متغير اسم ورقة المصدرومدى البيانات بها arr = Sheets("Sheet1").Range("A2:C" & lr).Value ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2)) j = 1 For i = LBound(arr, 1) To UBound(arr, 1) ' المعيار او الشرط الذي نبحث به If arr(i, 3) Like "*" & "P" & "*" Then For c = LBound(arr, 2) To UBound(arr, 2) temp(j, c) = arr(i, c) Next c j = j + 1 End If Next i 'متغير اسم ورقة الهدف واسم الخليه التي سيتم ترحيل العناوين اليها Sheets("Sheet2").Range("E5").Resize(, UBound(temp, 2)).Value = Array("Names", "Marks", "Status") 'متغير اسم ورقة الهدف واسم الخليه التي سيتم الترحيل اليها Sheets("Sheet2").Range("E6").Resize(j - 1, UBound(temp, 2)).Value = temp End Sub 1
ناصر سعيد قام بنشر مايو 4, 2017 الكاتب قام بنشر مايو 4, 2017 ============= استدعاء بشرط.rar ملف الكود السابق
ناصر سعيد قام بنشر مايو 4, 2017 الكاتب قام بنشر مايو 4, 2017 هل هذا السطر arr = Sheets("Sheet1").Range("A3").CurrentRegion.Value يغني عن 'متغير اسم ورقة المصدر lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 'متغير اسم ورقة المصدرومدى البيانات بها arr = Sheets("Sheet1").Range("A2:C" & lr).Value جزاك الله خيرا
ياسر خليل أبو البراء قام بنشر مايو 4, 2017 قام بنشر مايو 4, 2017 نعم أخي ناصر ولكن لابد أن تكون متأكد أن الضغط على Ctrl + A من لوحة المفاتيح سيحدد النطاق المطلوب العمل عليه بشكل صحيح لكي لا تحدث مشاكل أو يمكنك الاعتماد على الطريقة الثانية فهي أضمن وأفضل إذا لم تكن متأكد من النطاق الحالي 1
ناصر سعيد قام بنشر مايو 5, 2017 الكاتب قام بنشر مايو 5, 2017 Option Explicit 'هذا الكود للمحترم النابغه ياسر خليل 'الهدف من الكود هو ترحيل اعمده معينه لاعمده اخرى معينه 'تم هذا الكود في 15/2/2017 Sub Test() Dim arr As Variant Dim i As Variant Dim cr As Variant Dim j As Long Dim lr As Long 'متغير اسم ورقة المصدر lr = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row 'متغير اسم ورقة المصدرومدى البيانات بها arr = Sheets("Sheet1").Range("A1:K" & lr).Value 'الأعمدة المطلوب الترحيل إليها cr = Array(3, 5, 9) 'أرقام الأعمدة المطلوب ترحيلها For Each i In Array(2, 6, 10) Sheets("Sheet2").Cells(1, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) j = j + 1 Next i End Sub درر .. يجب الاحتفاظ بها مشاركات قام بنشر الان · ارسل تقرير عن المشاركه درر ...ترحيل اعمده معينه لاعمده اخرى في شيت اخر معينه Option Explicit 'هذا الكود للمحترم النابغه ياسر خليل 'الهدف من الكود هو ترحيل اعمده معينه لاعمده اخرى معينه 'تم هذا الكود في 15/2/2017 Sub Test() Dim arr As Variant Dim i As Variant Dim cr As Variant Dim j As Long Dim lr As Long 'متغير اسم ورقة المصدر lr = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row 'متغير اسم ورقة المصدرومدى البيانات بها arr = Sheets("Sheet1").Range("A1:K" & lr).Value 'الأعمدة المطلوب الترحيل إليها cr = Array(3, 5, 9) 'أرقام الأعمدة المطلوب ترحيلها For Each i In Array(2, 6, 10) Sheets("Sheet2").Cells(1, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) j = j + 1 Next i End Sub استدعاء اعمد معينه لاعمده اخرى معينه.
ياسر خليل أبو البراء قام بنشر مايو 6, 2017 قام بنشر مايو 6, 2017 بارك الله فيك أخي العزيز ناصر وجزيت خيراً على اهتمامك البالغ الأكواد المقدمة أحاول فك طلاسمها من خلال الفيديوهات للاستفادة منها بأشكال أخرى فالأكواد ليست لغرض أو لهدف واحد فقط إنما الهدف في المجمل تعلم اللغة وكيفية تطويعها للاستفادة منها بشكل أقصى وهذا شيء يسير من علم مليء وزاخر بالكنوز أرجو أن يستفيد الأخوة الذين يريدون التعلم من القناة على اليوتيوب ، والرجاء عمل اشتراك في القناة حيث أن ذلك يدعمني بشكل كبير تقبل وافر تقديري واحترامي 3
ناصر سعيد قام بنشر مايو 6, 2017 الكاتب قام بنشر مايو 6, 2017 الاستاذ الكبير ياسر خليل بعد التحيه ارجو ان يتم نسطير الصفوف التي يتم الاستدعاء عليها بالعدد .. بالكود
ياسر خليل أبو البراء قام بنشر مايو 6, 2017 قام بنشر مايو 6, 2017 أخي العزيز ناصر .. بعد وضع النتائج في نطاق معين ..على سبيل المثال إذا كانت النتائج تبدأ في الخلية G1 .. يمكنك الاعتماد على النطاق بالشكل التالي الإشارة لورقة العمل + أول خلية بالنطاق أو أي خلية داخل النطاق الذي يحتوي النتائج ثم استخدام خاصية CurrentRegion بهذا الشكل With Sheets("Sheet1").Range("G1").CurrentRegion .............. End With مكان النقاط في الكود يوضع سطر بسيط جداً للتسطير بهذا الشكل .Borders.Value=1 ولإلغاء التسطير استبدل الرقم 1 في السطر السابق بالقيمة صفر .. أرجو أن يفيدك الرد إن شاء الله 1
ناصر سعيد قام بنشر مايو 6, 2017 الكاتب قام بنشر مايو 6, 2017 تعطي الخطا الاصفر الاتــي =========== جزاك الله خيرا استاذ ياسر للهم في هذا اليوم المبارك اجعله لأعز الـــناس عندي يوما مبـــــــــــــــــــــــاركا فيه الدعوة لا تــــــــــــــرد وهبه رزقا لا يعـــــــــــــــد وافتح له باب في الجنة لا يسد واحشره في زمرة سيدنا محمد صلى الله عليه وسلم 1
ياسر خليل أبو البراء قام بنشر مايو 6, 2017 قام بنشر مايو 6, 2017 ارفق الملف الذي فيه المشكلة للإطلاع عليه .. حيث أن الصورة غير معبرة بشكل كامل عن المشكلة خصوصاً أن السطر غير ظاهر بشكل كامل وعندما يظهر معك خطأ يفضل توضيح رسالة الخطأ التي تظهر لك قبل النقر على كلمة Debug
ناصر سعيد قام بنشر مايو 6, 2017 الكاتب قام بنشر مايو 6, 2017 تفضل المرفق هذا الملف به الكود .. بالحــــدود.rar
ياسر خليل أبو البراء قام بنشر مايو 6, 2017 قام بنشر مايو 6, 2017 هل تريد تسطير النطاق بالكامل أم كل عمود على حدا .. عموماً جرب السطر التالي بعد السطر الذي يجلب البيانات من ورقة المصدر لورقة الهدف Sheets("Sheet2").Cells(4, cr(j)).Resize(UBound(arr, 1)).Borders.Value = 1
ناصر سعيد قام بنشر مايو 6, 2017 الكاتب قام بنشر مايو 6, 2017 تم الغاء هذا السطر ووضع السطر الذي تفضلتم به والاحظ السطر الملغى كان فيه الاندكس وتم الغاؤه وعمل الكود وتم تسطير الاعمده فقط ثانيا نريد تسطير النطاق بالكامل ' Sheets("Sheet2").Cells(4, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) ================== عمل الكود مره واحده تمام ولم يات بتائج المرات الاخرى
ياسر خليل أبو البراء قام بنشر مايو 6, 2017 قام بنشر مايو 6, 2017 لا يتم إلغاء السطر Index فهو يجلب النتائج وبعدها سطر آخر يتم تسطير النتائج به ..
ناصر سعيد قام بنشر مايو 6, 2017 الكاتب قام بنشر مايو 6, 2017 تمام التمام .. يبارك فيك ربنا استاذ ياسر معلش فيه لازم عشان الكود يكون كثير الاستعمال والسهوله للجميع لابد من سطر يمسح البيانات السابقه عشان يضع البانات الجديه على نضيف لان ممكن البيانات المرحله تتغي تقل في صفوفها فتظل البيانات القديمه ودي مشكله ولاتنسانا في تسطير المدى كله جزاك الله خيرا
ناصر سعيد قام بنشر مايو 6, 2017 الكاتب قام بنشر مايو 6, 2017 الكود بعد اضافة ميزة تسطير الاعمده المرحل اليها Option Explicit 'هذا الكود للمحترم النابغه ياسر خليل 'الهدف من الكود هو ترحيل اعمده معينه لاعمده اخرى معينه بالتسطير 'تم هذا الكود في 6/5/2017 Sub Test() 'متغيرات Dim arr As Variant Dim i As Variant Dim cr As Variant Dim j As Long Dim lr As Long lr = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row 'اسم شيت المصدر واسم الخليه الاولى منه arr = Sheets("Sheet1").Range("A7:K" & lr).Value 'الأعمدة المطلوب الترحيل إليها cr = Array(3, 5, 7) 'أرقام الأعمدة المطلوب ترحيلها For Each i In Array(1, 3, 5) 'اسم شيت الهدف ورقم صف صفحة الهدف Sheets("Sheet2").Cells(4, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) Sheets("Sheet2").Cells(4, cr(j)).Resize(UBound(arr, 1)).Borders.Value = 1 j = j + 1 Next i End Sub
ياسر خليل أبو البراء قام بنشر مايو 6, 2017 قام بنشر مايو 6, 2017 بارك الله فيك وجزاك الله خيراً يفضل في الأكواد بالفعل وضع أسطر لمسح محتويات النطاق الذي سيحوي النتائج الجديدة .. وهذا أمر لا يتطلب الكثير حيث يمكن وضع أسطر قبل الكود تقوم بالمسح وإزالة الحدود ... كما وضحت وبعد وضع النتائج يتم وضع سطر يقوم بالتسطير تقبل تحياتي
ناصر سعيد قام بنشر مايو 6, 2017 الكاتب قام بنشر مايو 6, 2017 24 دقائق مضت, ياسر خليل أبو البراء said: وهذا أمر لا يتطلب الكثير حيث يمكن وضع أسطر قبل الكود تقوم بالمسح وإزالة الحدود ... كما وضحت وبعد وضع النتائج يتم وضع سطر يقوم بالتسطير سهلها اكثر الله يسهلها عليك
ياسر خليل أبو البراء قام بنشر مايو 7, 2017 قام بنشر مايو 7, 2017 أخي العزيز ناصر أنا لا أدري بالضبط شكل المخرجات المطلوبة .. هل الأعمدة الغير متجاورة في النتائج هي المطلوب تسطيرها فقط أم أن نطاق النتائج بالكامل سواء كانت في الأعمدة المتجاورة أو غير المتجاورة هي المطلوبة؟ أعطيتك الدليل ببساطة تشير لورقة العمل ثم النطاق ثم تضع كلمة Borders.Value وبعدها علامة يساوي وتضع القيمة 1 للتسطير والقيمة 0 لإزالة التسطير .. كل ما عليك هو تحديد النطاق المطلوب حاول وإن شاء الله تفلح بالأمر .. وفقك الله لما يحبه ويرضاه
الردود الموصى بها