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

[عادل ابوزيد]

الاساتذه الكرام

بالملف المرفق بيانات موضوعها فى عده اعمده ( 12 ) عمود وقد تصل إلى 100 عمود

والمطلوب : عمل كود يقوم بتجميع الاعمده فى عمود واحد بحيث يبدأ ببيانات العمود الاول ثم اسفله بيانات العمود الثانى وهكذا

وليس المقصود دمج المحتويات بمعنى لا نستخدم CONCATENATEدالة

لانها غير المقصوده

تجميع اعمده فى عمود.rar

[احمد عبد الناصر]

السلام عليكم

 

جرب هذه 

Sub Dahmour()
arr = Range("e3:" & Cells.SpecialCells(xlCellTypeLastCell).Address)
For Each i In arr
If Not IsEmpty(i) Then
Cells(r + 3, 2) = i
r = r + 1
End If
Next
End Sub

تحياتي

+تجميع اعمده فى عمود.rar

[عادل ابوزيد]

استاذنا الكبير

احمد عبد الناصر

زادكم الله من علمه كود ولا اروع

كل مشاركاتكم مؤثرة ونتعلم منها لذلك لو تكرمت ممكن شرح الكود

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

الاول : لبيانات رقمية

والثانى لبيانات نصية

+تجميع اعمده فى عمودنصى وآخر رقمى.rar

تم تعديل أبريل 27, 2013 بواسطه عادل ابوزيد

[احمد عبد الناصر]

السلام عليكم

 

جرب هذا 

Sub Dahmour()
arr = Range("e3:" & Cells.SpecialCells(xlCellTypeLastCell).Address)
For Each i In arr
If Not IsEmpty(i) Then
If IsNumeric(i) Then
Cells(r + 3, 2) = i
Else
Cells(rr + 3, 3) = i
rr = rr + 1
End If
r = r + 1
End If
Next
End Sub

ملاحظة : يترك فراغات في العمود B كما في الملف . لا اعلم  ان كان هذا مقصود .

 

تحياتي

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

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

 

 

أخي الكريم أحمد، كود ولا أروع جازاك الله كل الخير وحفظك  الله من كل سوء...

 

أخوك بن علية

[عادل ابوزيد]

الاستاذ الفاضل العزيز

ترك الفراغات غير مقصود حيث تم عملها يدوياً لاوضح المطلوب ان كان مكانها الاسماء

وبرجاء تعديل الكود لعدم رغبتى فى وجود فراغات مع شرحه اذا تكرمت

[احمد عبد الناصر]

السلام عليكم

 

استاذنا بن علية مرور شخصكم الكريم شرف لي , اسعد الله اوقاتك 

 

 

تقبل تحياتي

[احمد عبد الناصر]

السلام عليكم

 

استاذ عادل 

 

جرب هذه 

Sub Dahmour()
arr = Range("e3:" & Cells.SpecialCells(xlCellTypeLastCell).Address)
For Each i In arr
If Not IsEmpty(i) Then
If IsNumeric(i) Then
Cells(r + 3, 2) = i
r = r + 1
Else
Cells(rr + 3, 3) = i
rr = rr + 1
End If
End If
Next
End Sub

بالنسبة لموضوع الشرح اعذرني فانا لست جيد في الشروحات ولكن اختر جزئية معينة و سوف احاول شرحها باذن الله 

 

تحياتي

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

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

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

 أخي الكريم عادل، لأجل ذلك، وأسنسمح أخي الحبيب أحمد، أبدل الكود السابق بالكود التالي:

 

Sub Dahmour()
arr = Range("e3:" & Cells.SpecialCells(xlCellTypeLastCell).Address)
For Each i In arr
If Not IsEmpty(i) And IsNumeric(i) Then Cells(r + 3, 2) = i: r = r + 1
If Not IsEmpty(i) And IsNumeric(i) = False Then Cells(t + 3, 3) = i: t = t + 1
Next
End Sub
 

 

أخوك بن علية

[عادل ابوزيد]

الاستاذ العزيز القدير احمد عبد الناصر

من اعماق قلبى اشكرك ومن اجمل البساتين ارسل لك اجمل الباقات تحية لشخصكم الكريم على مشاركاتكم العظيمه النبيلة كل منى كل دعاء فيه صلاح لك فى دينك ودنياك

الاستاذ الكبير بن عليه حاجى

مشاركاتكم وسام على صدرى تقبل منى كل الحب والتقدير

بخصوص الشرح

هل من الممكن شرح هذا السطر ماذا يعنى

arr = Range("e3:" & Cells.SpecialCells(xlCellTypeLastCell).Address)

وماذا تعنى هذه الاسطر

Cells(r + 3, 2) = i

r = r + 1

Else

Cells(rr + 3, 3) = i

[احمد عبد الناصر]

السلام عليكم

 

شكرا على كلماتك الجميلة و دعائك ,غفر الله لنا ولكم و سائر المسلمين .

 

arr = Range("e3:" & Cells.SpecialCells(xlCellTypeLastCell).Address)

هذا السطر ياتي بنطاق البيانات بداية من الخلية E3 ويتسع حتي عنوان Address اخر خلية مستخدمة في الاكسيل مثلا في الملف اخر خلية هي $AN$38

ربما هذه الطريقة تاتي بنطاق اكبر من الحاجة لكنها والله اعلم افضل طريقة للاحاطة بكل البيانات . 

وبهذا فتكون الجملة 

arr = Range("e3:$AN$38")

وبهذا يتم تخصيص المجموعة array المسماة arr بقيم النطاق .

 

وهدف هذه الخطوة انه تمكنا من الدوران loop في البيانات  علي هيئة عمود عمود من الاعلى للاسفل .

 

اما لو استخدمت loop مع النطاق مباشرة فستكون النتيجة علي صف صف من اليمين لليسار .

 

تحياتي 

[عادل ابوزيد]

استاذى احمد عبد الناصر

انت متواضع جداً فشرحك رائع

الان عرفنا تحديد مكان البحث

كيف نفرق بين خليه بها نص وخليه بها رقم

ومكان اللصق

برجاء التوضيح

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

الاخ احمد عبد الناصر

اكواد جميله

ومتقنه بارك الله فيك