ما هو افضل كود لاداء هذه الوظيفه

[إبراهيم ابوليله]

الاخوه الافاضل

اريد كود يقوم بتكرار

ادخال البيانات الموجود فى العمود

بالشكل الموضح فى الشيت المرفق

تقبلو تحياتى

Book1.rar

[بن علية حاجي]

السلام عليكم ورحمة الله

 

أخي الكريم إبراهيم، بالمعادلات تجد حلا في المرفق مع إضافة خاصية "عدد مرات تكرار كل عدد" وأرجو أن يروقك هذا الحل...

 

أخوك بن علية

 

 

المرفق : Book1_1.rar 

[مختار حسين محمود]

السلام عليكم ورحمة الله وبركاته

 

وهذا حل بالأكواد مع إضافة خاصية "عدد مرات تكرار كل عدد"

 

 

تلميذكم مختار حسين

 

تحياتى

Book2.rar

تم تعديل مارس 24, 2015 بواسطه مختار حسين محمود

[سليم حاصبيا]

 لعله المطلوب

تكرار.rar

[سليم حاصبيا]

اخي ابراهيم

خيار اخر لعله ينال اعجابك

تكرار على ذوقك.rar

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

أخي الحبيب إبراهيم أبو ليلة ..

هل ما زالت المشكلة قائمة بعد كل هذه الحلول ؟؟

..

هل عدد مرات التكرار ثابت ( 4 مرات ) كما بالنتائج المرفقة !!!

[إبراهيم ابوليله]

اخى واستاذنا بن عليه

انا سعيد جدا بوجودك معانا

فى هذه المشاركات

المعادله جميله جدا

تقبل تحياتى

-----------------------------------

اخى سليم حليين فى غاية الروعه والجمال

وانا شخصيا استفدت منهم كتير

تقبل تحياتى

[إبراهيم ابوليله]

 

السلام عليكم ورحمة الله وبركاته

 

وهذا حل بالأكواد مع إضافة خاصية "عدد مرات تكرار كل عدد"

 

 

تلميذكم مختار حسين

 

تحياتى

 

اخى مختار

كود جميل ويعمل بنجاح

اشكرك على الاهتمام

وعلى الهديه الجميله

تقبل تحياتى

[إبراهيم ابوليله]

أخي الحبيب إبراهيم أبو ليلة ..

هل ما زالت المشكلة قائمة بعد كل هذه الحلول ؟؟

..

هل عدد مرات التكرار ثابت ( 4 مرات ) كما بالنتائج المرفقة !!!

اخى ياسر

كن صبورا

كن حليما

فاننى لم ارى المشاركات

والردود الا الان

......................................

الاهم ان طلبى افضل كود

والاغلب فى المشاركات

والحلول كانت بالمعادلات

....................................

فى انتظار حلول اخرى بالاكواد

اذا كانت هناك حلول اخرى من اعضاء اخرين

اذا لم يكن

ساكتفى بالحل الخاص بالاخ مختار

......................................

تقبل تحياتى

[شوقي ربيع]

السلام عليكم

الشكر موصول لكل الاعضاء

جرب هذا الكود

Sub TEST()
Dim x(): x = Range("B4:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value
Dim i As Integer: For i = 1 To UBound(x)
Dim n: n = n + 4: Range("G" & n).Resize(4, 1).Value = x(i, 1)
                  Next: End Sub

هذا كود اخر اسرع من الكود الاول

Sub TEST2()
Dim ObjCell As Range
For Each ObjCell In Range("B4:B" & Cells(Rows.Count, "B").End(xlUp).Row).Cells
Dim n: n = n + 4: Range("G" & n).Resize(4, 1).Value = ObjCell.Value
Next
End Sub

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

بسم الله ما شاء الله عليك أخي شوقي

بعد إذنك الكود الثاني عجبني فأضفت إليه إضافة بسيطة بحيث يعتمد على العمود اللي جنب عمود الأرقام في عدد مرات التكرار ..

إليك الملف المرفق

Populate Numbers Shawky.rar

[إبراهيم ابوليله]

اخى ياسر

شوفت بقى لما صبرت على رزقك

ربنا بعتلنا العلامه

شوقى باجمل الاكواد

تقبل تحياتى

[إبراهيم ابوليله]

اخى واستاذنا شوقى

مفيش كلام على اللسان

يعبر عن ما بداخل الصدور

غير

بارك الله فيك

وزادك من فضله وعلمه

تقبل تحياتى

[إبراهيم ابوليله]

 

السلام عليكم

الشكر موصول لكل الاعضاء

جرب هذا الكود

Sub TEST()
Dim x(): x = Range("B4:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value
Dim i As Integer: For i = 1 To UBound(x)
Dim n: n = n + 4: Range("G" & n).Resize(4, 1).Value = x(i, 1)
                  Next: End Sub

هذا كود اخر اسرع من الكود الاول

Sub TEST2()
Dim ObjCell As Range
For Each ObjCell In Range("B4:B" & Cells(Rows.Count, "B").End(xlUp).Row).Cells
Dim n: n = n + 4: Range("G" & n).Resize(4, 1).Value = ObjCell.Value
Next
End Sub

اخى شوقى

فى طلب بسط

هو ايه

ان فى الكود

يتم تحديد اول صف سيتم استخراج

البيانات فيه

عن طريق المتغير N

الى هو مرتبط

بعدد مرات الاستخراج اى الرقم 4

لكن لو عدد مرات الاستخراج 6

وان عايز ان بداية الاستخراج تكون من الصف 3

ممكن تقولى

شكل الكود هيكون ازاى

تقبل تحياتى

[شوقي ربيع]

بسم الله ما شاء الله عليك أخي شوقي

بعد إذنك الكود الثاني عجبني فأضفت إليه إضافة بسيطة بحيث يعتمد على العمود اللي جنب عمود الأرقام في عدد مرات التكرار ..

إليك الملف المرفق

اذنك معك اخي ياسر انت تأمر و جزاك الله خيرا على اضافتك الجميلة

[شوقي ربيع]

اخى شوقى

د

فى طلب بسط

هو ايه

ان فى الكود

يتم تحديد اول صف سيتم استخراج

البيانات فيه

عن طريق المتغير N

الى هو مرتبط

بعدد مرات الاستخراج اى الرقم 4

لكن لو عدد مرات الاستخراج 6

وان عايز ان بداية الاستخراج تكون من الصف 3

ممكن تقولى

شكل الكود هيكون ازاى

تقبل تحياتى

 

الكود يكون كالاتي

Sub TEST()
Dim x(): x = Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value
Dim n: n = 4
Dim i As Integer: For i = 1 To UBound(x)
                  Range("G" & n).Resize(6, 1).Value = x(i, 1)
                  n = n + 6
                  Next: End Sub

او

                  
Sub TEST2()
Dim ObjCell As Range
Dim n: n = 4
For Each ObjCell In Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row).Cells
         Range("G" & n).Resize(6, 1).Value = ObjCell.Value
         n = n + 6
         Next: End Sub

حيث n = 4 هي بداية الصف الذي ترحل اليه البيانات

[سليم حاصبيا]

بعد اذن الاخوان الكرام

حل اخر بواسطة الكود

repete au choix.rar

[إبراهيم ابوليله]

اخى سليم

بالفعل

هذا الكود اكثر من رائع

الاجمل فيه

هو البساطه

مشكورا اخى الفاضل

نسأل الله ان يزيدك من فضله وعلمه

.............................................

ولكن نا فائده هذا السطر

If lrd = 1 Then lrd =

تقبل تحياتى

[إبراهيم ابوليله]

اخى واستاذنا شوقى

ماذا لو اردنا

تطبيق الكود على العمود A

مع العمود  B

واستخراج البيانات فى عمودين ايضا

For Each ObjCell In Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row).Cells

كيف سيكون شكل الكود

Range("G" & n).Resize(6, 1).Value = ObjCell.Value

تقبل تحياتى

[شوقي ربيع]

اخى واستاذنا شوقى

ماذا لو اردنا

تطبيق الكود على العمود A

مع العمود  B

واستخراج البيانات فى عمودين ايضا

For Each ObjCell In Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row).Cells

كيف سيكون شكل الكود

Range("G" & n).Resize(6, 1).Value = ObjCell.Value

تقبل تحياتى

 

فرضا اننا سنرحل البيانات التي في العمود A و العمود B ابتدأ من السطر 4

الى الاعمدة D و E ابتدأ من السطر 4 ايضا يكون الكود كالتالي

Sub TEST()
Dim ObjCell As Range
Dim n: n = 4
For Each ObjCell In Range("A4:A" & Cells(Rows.Count, "B").End(xlUp).Row).Cells
         Range("D" & n).Resize(3, 2).Value = ObjCell.Resize(1, 2).Value
         n = n + 3
         Next: End Sub