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



أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





ترحيل مرن وسريع وسهل ضبطه

السلام عليكم نظرا لكثرة الاسئلة عن طريقة الترحيل لاعمدة غير مرتبة ومتفرقة وخلافة من هذه الامور قمت بعمل ترحيل يناسب ا ..



15-12-2017 12:32 صباحا
Yasser Elaraby
menu_open عضوية موثقة
المشرف العام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 1
المشاركات : 818
الجنس : ذكر
الدعوات : 11
يتابعهم : 2
يتابعونه : 472
قوة السمعة : 5838
الاعجاب : 1538
موقعي : زيارة موقعي
 offline 

السلام عليكم 
MTY3ODkx23132132
نظرا لكثرة الاسئلة عن طريقة الترحيل لاعمدة غير مرتبة ومتفرقة وخلافة من هذه الامور 
قمت بعمل ترحيل يناسب اغلب الاخوة في احتياجاتهم 
الكود مرن جدا كل ما عليك هو تحديد اسم صفحة ادخال البيانات وصفحة قاعدة البيانات 
وارقام اعمدة البداية لادخال البيانات وايضا اول صف به بيانات 
وعدد الاعمدة المراد الترحيل منها 
والنقطة الاهم والمميزة وهي ترتيب اعمدة صفحة الادخال بما يقابلها من اعمدة قاعدة البيانات 
وتستطيع ترك اعمدة بين اعمدة الترحيل بدون الترحيل لها 
الكود 
Sub Yasser()
    Dim Add As Worksheet
    Dim Data As Worksheet
    Dim ar1 As Variant
    Dim ar2 As Variant
    Dim arr As Variant
    Dim v As Long, rw, x, xx
    Const co1 As Long = 2 'رقم اول عمود لصفحة ادخال البيانات
    Const co2 As Long = 3  'رقم اول عمود لصفحة قاعدة البيانات
    Const ro1 As Long = 5 'رقم اول صف ترحيل بيانات في صفحة ادخال البيانات
    Const co_num1 As Long = 20 ' عدد الاعمدة المراد الترحيل منها
    Set Add = Sheets("Enter") 'اسم صفحة ادخال البيانات
    Set Data = Sheets("Data") 'اسم صفحة قاعدة البيانات
    ar1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 16) ' ترتيب اعمدة صفحة الادخال
    ar2 = Array(2, 1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 16) 'ترتيب اعمدة قاعدة البيانات بما يقابلها من صفحة ادخال البيانات
    arr = Add.Range(Add.Cells(ro1, co1), Cells(Add.Cells(Rows.Count, co1).End(xlUp).Row, co1 + co_num1)).Value
    If Add.Cells(ro1, co1) = "" Then MsgBox "يرجى ادخال البيانات ثم الترحيل": Exit Sub
    v = Data.Cells(Rows.Count, co2).End(xlUp).Row
        For xx = LBound(ar2) To UBound(ar2)
        ReDim y(1 To UBound(arr, 1))
            For x = LBound(arr) To UBound(arr)
            If ar2(xx) <> "" Then
               rw = rw + 1
                y(rw) = arr(x, ar1(xx))
            End If
        Next
    If rw > 0 Then Data.Cells(v, co2 + (ar2(xx) - 1))(2, 1).Resize(UBound(y, 1)).Value = Application.Transpose(y)
        Erase y
        rw = 0
    Next
    Erase arr
    Add.Range(Add.Cells(ro1, co1), Cells(Add.Cells(Rows.Count, co1).End(xlUp).Row, co1 + co_num1)).ClearContents
    MsgBox "Done............"
End Sub

اترك لكم التجربة لان الوقت لا يسمح لعدة محاولات اذاصادفتكم اي مشاكل يرجى ارفاقها في مشاركة اسفل الموضوع 
الملف مرفق
لرؤية الروابط والمرفقات عليك الرد على الموضوع
اعداد / ياسر العربي
142




لرؤية الروابط والمرفقات عليك الرد على الموضوع


أثارت هذه المشاركة إعجاب: محمود ابو الدهب، saifbasaif، محمد الدسوقى، el hofy، كاردوس، abdulwahed catran، احمد الحاوي، محمد أبو عبدو، Galal ELGammal، abdelsatar، malik، YasserKhalil، ابراهيم80، Kamel meraghni، ابوعبدالواجد، كاري محمد، ابوحمزه، عبدالله الضراسي، بكار للأبد، abo-alhussien، Eslam Abdullah، ghaly802003، محمد حسن المحمد، mahmoud ayad، قتيبة الحسني،


توقيع :Yasser Elaraby
663013020




15-12-2017 12:46 صباحا
مشاهدة مشاركة منفردة [1]
محمود ابو الدهب
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 672
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 56
يتابعهم : 6
يتابعونه : 140
قوة السمعة : 2382
الاعجاب : 859
 offline 
look/images/icons/i1.gif ترحيل مرن وسريع وسهل ضبطه
بارك الله فيك استاذ ياسر العربي رائع رائع رائع
ولى رجاء اذا كان احدهم يريد ان يضع شرط في الترحيل هل يمكن تعديل هذا الكود ليقبل شروط 
ام هو لترحيل اعمدة غير متجاورة فقط 

واكرر شكرى لحضرتك على هذا العمل الرائع 
وبارك الله فيك 

أثارت هذه المشاركة إعجاب: Yasser Elaraby،


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

تحياتى وتقدير للجميع  محمود ابوالدهب


15-12-2017 12:59 صباحا
مشاهدة مشاركة منفردة [2]
Yasser Elaraby
menu_open عضوية موثقة
المشرف العام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 1
المشاركات : 818
الجنس : ذكر
الدعوات : 11
يتابعهم : 2
يتابعونه : 472
قوة السمعة : 5838
الاعجاب : 1538
موقعي : زيارة موقعي
 offline 
look/images/icons/i1.gif ترحيل مرن وسريع وسهل ضبطه
الشروط اشكال والوان حدد الشروط اللي محتاجها على ملف وارفقه وان شاء  الله اعدل الملف ليناسب الشروط
بس حاليا يادوب بقي الواحد يناااااااام تصبح على خيرر blink

أثارت هذه المشاركة إعجاب: محمود ابو الدهب،


توقيع :Yasser Elaraby
663013020



15-12-2017 01:05 صباحا
مشاهدة مشاركة منفردة [3]
محمود ابو الدهب
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 672
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 56
يتابعهم : 6
يتابعونه : 140
قوة السمعة : 2382
الاعجاب : 859
 offline 
look/images/icons/i1.gif ترحيل مرن وسريع وسهل ضبطه
كنت اقصد ان يكون الشرط متغير بمعنى يكفينى ان احدد رقم العمود الذى به الشرط ثم احدد هلى يحتوى هذا العمود على كذا او كبر من كذا او اصغر او يساوى 
اى اقصد ان يكون مثل الكود سهل للمستخدم العادى او للى مش بيعرف يتعامل مع الاكواد يسهل التعامل معه 


وانا كمان يدوبك دلوقتى انام احلام سعيده ليك وليا ومتنشاس اتغطي كويس بدل ما الاحلام تقلب كوابيس biggrin2 واحنا في الشتاء

تحياتى وتقديرى لك 113


تم تحرير المشاركة بواسطة :محمود ابو الدهب
بتاريخ:15-12-2017 01:06 صباحا


أثارت هذه المشاركة إعجاب: Yasser Elaraby، مالك ماريه، ناصر سعيد1، عبدالله الضراسي،


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

تحياتى وتقدير للجميع  محمود ابوالدهب


15-12-2017 04:55 صباحا
مشاهدة مشاركة منفردة [4]
احمد ابوساجد
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 30-09-2017
رقم العضوية : 779
المشاركات : 7
الجنس : ذكر
يتابعهم : 8
يتابعونه : 0
قوة السمعة : 14
الاعجاب : 2
 offline 
look/images/icons/i1.gif ترحيل مرن وسريع وسهل ضبطه
المحترم بزياده     كنت بسأل على الترحيل من الفورم حسب كود الصنف

أثارت هذه المشاركة إعجاب: Yasser Elaraby، عبدالله الضراسي،




15-12-2017 12:57 مساء
مشاهدة مشاركة منفردة [5]
ناصر سعيد1
menu_open
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-09-2017
رقم العضوية : 705
المشاركات : 440
الجنس : ذكر
تاريخ الميلاد : 2-2-1990
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 479
الاعجاب : 180
 offline 
look/images/icons/wub.gif ترحيل مرن وسريع وسهل ضبطه
المحترم ياسر العربي
كا فأك الله بكل خير
وبعد :
هذا هو الملف الذي نريد ان نتشرف باضافة كودك الرائع اليه
والشرطين موجودين في صفحه الهدف

لرؤية الروابط والمرفقات عليك الرد على الموضوع




لرؤية الروابط والمرفقات عليك الرد على الموضوع


أثارت هذه المشاركة إعجاب: Yasser Elaraby،




15-12-2017 05:44 مساء
مشاهدة مشاركة منفردة [6]
كاردوس
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 26-11-2017
رقم العضوية : 1941
المشاركات : 1
الجنس : ذكر
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 12
الاعجاب : 1
 offline 
look/images/icons/i1.gif ترحيل مرن وسريع وسهل ضبطه
عمل جميل ومفيد جداً .... شكراً جزيلاً لك 

أثارت هذه المشاركة إعجاب: Yasser Elaraby،




15-12-2017 08:10 مساء
مشاهدة مشاركة منفردة [7]
Yasser Elaraby
menu_open عضوية موثقة
المشرف العام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 1
المشاركات : 818
الجنس : ذكر
الدعوات : 11
يتابعهم : 2
يتابعونه : 472
قوة السمعة : 5838
الاعجاب : 1538
موقعي : زيارة موقعي
 offline 
look/images/icons/i1.gif ترحيل مرن وسريع وسهل ضبطه
المشاركة الأصلية كتبت بواسطة: ناصر سعيد1 »
المحترم ياسر العربي
كا فأك الله بكل خير
وبعد :
هذا هو الملف الذي نريد ان نتشرف باضافة كودك الرائع اليه
والشرطين موجودين في صفحه الهدف

لرؤية الروابط والمرفقات عليك الرد على الموضوع


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

لرؤية الروابط والمرفقات عليك الرد على الموضوع




لرؤية الروابط والمرفقات عليك الرد على الموضوع


أثارت هذه المشاركة إعجاب: ناصر سعيد1، تاج الدين،


توقيع :Yasser Elaraby
663013020



15-12-2017 08:51 مساء
مشاهدة مشاركة منفردة [8]
ناصر سعيد1
menu_open
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-09-2017
رقم العضوية : 705
المشاركات : 440
الجنس : ذكر
تاريخ الميلاد : 2-2-1990
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 479
الاعجاب : 180
 offline 
look/images/icons/i1.gif ترحيل مرن وسريع وسهل ضبطه
استاذ ياسر العربي
يحفظك الرحمن
وبعد :
المسلسل خليه يظهر مع الكود
وكذلك التسطير بعدد المستدعى
جزاك الله كل خير





15-12-2017 08:53 مساء
مشاهدة مشاركة منفردة [9]
ناصر سعيد1
menu_open
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-09-2017
رقم العضوية : 705
المشاركات : 440
الجنس : ذكر
تاريخ الميلاد : 2-2-1990
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 479
الاعجاب : 180
 offline 
look/images/icons/i1.gif ترحيل مرن وسريع وسهل ضبطه
من فضلك شويه شرح للاسطر عشان حبايبك






15-12-2017 09:32 مساء
مشاهدة مشاركة منفردة [10]
محمد أبو عبدو
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-08-2017
رقم العضوية : 247
المشاركات : 110
الجنس : ذكر
تاريخ الميلاد : 13-4-1966
يتابعهم : 6
يتابعونه : 2
قوة السمعة : 333
الاعجاب : 160
 offline 
look/images/icons/i1.gif ترحيل مرن وسريع وسهل ضبطه
أستاذنا الفاضل زادك الله علما وبركة وجزاك الله عنا خير الجزاء


أثارت هذه المشاركة إعجاب: ناصر سعيد1،




15-12-2017 09:56 مساء
مشاهدة مشاركة منفردة [11]
ناصر سعيد1
menu_open
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-09-2017
رقم العضوية : 705
المشاركات : 440
الجنس : ذكر
تاريخ الميلاد : 2-2-1990
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 479
الاعجاب : 180
 offline 
look/images/icons/i1.gif ترحيل مرن وسريع وسهل ضبطه
المشاركة الأصلية كتبت بواسطة: محمد أبو عبدو »
أستاذنا الفاضل زادك الله علما وبركة وجزاك الله عنا خير الجزاء

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

أثارت هذه المشاركة إعجاب: Yasser Elaraby،




16-12-2017 12:31 صباحا
مشاهدة مشاركة منفردة [12]
ناصر سعيد1
menu_open
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-09-2017
رقم العضوية : 705
المشاركات : 440
الجنس : ذكر
تاريخ الميلاد : 2-2-1990
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 479
الاعجاب : 180
 offline 
look/images/icons/i1.gif ترحيل مرن وسريع وسهل ضبطه
بفضل من الله
تم عمل الاسطر البرمجيه الخاصه بالتسطير
اولا : هل موقعها تمام في الكود ؟

ثانيا لم استطع وضع سطربرمجي لعمل المسلسل  فارجو اضافته
جزاكم الله خيرا

Sub Yasser()
'هذا الكود للمحترم ياسر العربي
'الهدف من الكود هو استدعاء بيانات
'بشرطين من خارج الكود
'تم هذا الكود بتاريخ 15/12/2017
'========
    Dim Main As Worksheet
    Dim Sh As Worksheet
    Dim j       As Long
    Dim ar1 As Variant
    Dim ar2 As Variant
    Dim arr As Variant
    Dim v As Long, rw, x, xx
    Const co1 As Long = 2 'رقم اول عمود لصفحة المصدر
    Const co2 As Long = 3  'رقم اول عمود لصفحة الهدف
    Const ro1 As Long = 7 'رقم اول صف لصفحة المصدر
    Const co_num1 As Long = 150 ' عدد الاعمدة المراد الترحيل منها
    Set Main = Sheets("رصد الترم الثانى") 'اسم صفحة المصدر
    Set Sh = Sheets("الهدف") 'اسم صفحة الهدف
    
    ar1 = Array(1, 2, 139, 143, 141, 142, 7, 8, 9, 10, 11, 13, 15, 132) ' ترتيب اعمدة صفحة المصدر
    
    ar2 = Array(1, 2, 3, 4, 5, 6, 8, 7, 9, 10, 11, 13, 15, 35) 'ترتيب اعمدة قاعدة البيانات بما يقابلها من صفحة  الهدف
    
    'لمنع اهتزاز الشاشه
    Application.ScreenUpdating = 0
    Sh.Range(Sh.Cells(ro1, co2), Sh.Cells(Sh.Cells(Rows.Count, co2).End(xlUp).Row + 1, co2 + co_num1)).ClearContents
 
    arr = Main.Range(Main.Cells(ro1, co1), Main.Cells(Main.Cells(Rows.Count, co1).End(xlUp).Row, co1 + co_num1)).Value
    If Main.Cells(ro1, co1) = "" Then MsgBox "يرجى ادخال البيانات ثم الترحيل": Exit Sub
    v = Sh.Cells(Rows.Count, co2).End(xlUp).Row
        For xx = LBound(ar2) To UBound(ar2)
        
        ReDim y(1 To UBound(arr, 1))
            For x = LBound(arr) To UBound(arr)
            j = 1
            If ar2(xx) <> "" Then
            If arr(x, 132) Like Sh.Range("D1") & "*" And arr(x, 143) Like Sh.Range("E1") Then
               rw = rw + 1
                y(rw) = arr(x, ar1(xx))
                End If
            End If
        Next
    If rw > 0 Then Sh.Cells(v, co2 + (ar2(xx) - 1))(2, 1).Resize(UBound(y, 1)).Value = Application.Transpose(y)
        Erase y
        rw = 0
    Next
    Erase arr
   '========
  'سطر لمسح التسطير
  Sh.Range("B7:AM" & Rows.Count).Borders.Value = 0
 
        'سطر لاضافة التسطير
   Sh.Range("B7:AM" & Cells(Rows.Count, 3).End(xlUp).Row).Borders _
       .Weight = xlMedium
   '=======
   'لاعاده الشاشه
      Application.ScreenUpdating = 1
    MsgBox "الحمد لله تم المطلوب"
End Sub

أثارت هذه المشاركة إعجاب: محمد الدسوقى،





المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
اكسل vbaجصريا فورم بحث وتعديل البيانات فى جميع اوراق العمل(شيتات الاكسل ) بطريقة سهلة وسريعة emad ghazi
21 365 S.Dreat
اكسل vba ترحيل البيانات اتوماتيكيا الى عدد غير محدود من اوراق العمل بطريقة سهله وسريعه emad ghazi
9 2959 محمد أبو العنين
اريد طريقة سهله وسريعة للترقيم المتسلسل في الاكسل عمودي وافقي في نفس الوقت ابو يوسف80
14 253 Eslam Abdullah
اكسل vba حذف اوراق العمل الفارغة بطريقة سهلة وسريعة emad ghazi
5 939 emad ghazi

الكلمات الدلالية
ترحيل ، وسريع ، وسهل ، ضبطه ،


 







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



الساعة الآن 04:40 مساء

أعلن هنا
أعلن هنا
أعلن هنا