مكتبة الموقع - كود لقلب وضعية بلوكات كاملة

[محمد طاهر عرفه]

اعرض الملف

كود لقلب وضعية بلوكات كاملة

---

طلب مني  زميل حل لعكس ترتيب مجموعة من بلوكات البيانات من الوضعية الافقية الي الوضع الرأسي

و ذلك دون تغيير وضعية البيانات داخل البلوك الواحد ، كما هو مبين فى الضورة

يمتاز الكود بعدم مجدودية عدد البلوكات (يتم الاختيار طبقا للتظليل) و يمكن تعديله بسهولة ليناسب اعداد الاعمدة المختلفة داخل البلوك و ذلك يتعديل قيمة متغير واحد فى الكود.

 

و لكي تستخدم هذا الكود قم اولا بتحديد عدد الأعمدة داخل كل بلوك عن طريق المتغير CC فى الكود

و فى المثال هنا عدد أعمدة كل بلوك هو 3 ـ و يمكنك تغييره كما تشاء

ثم قم بتظليل كافة البيانات المراد تغيير وضعها على أن تكون عدد الاعمدة المختارة من مضاعفات الرقم المختار لأعمدة كل بلوك

ثم شغل الكود

Sub PivotBlocks_arafa()

 Dim r, c, b As Integer
 Dim g As String
 
 cc = 3  ' قم بتعديل هذا الرقم لتغيير عدد الاعمدة الافتراضي فى البلوك الوحد
 r = Selection.Rows.Count
 c = Selection.Columns.Count
 b = c / cc
 g = ActiveCell.Address
 
 For x = 1 To b - 1
    Range(ActiveCell.Offset(0, cc * x), ActiveCell.Offset(r - 1, cc * x + cc - 1)).Cut
    ActiveCell.Offset(r * x - 1 + 1, 0).Activate
    ActiveSheet.Paste
    Range(g).Activate
  Next x
 
End Sub

 

---

• صاحب الملف
  محمد طاهر
• تمت الاضافه
  07 يول, 2020
• الاقسام
  قسم الإكسيل

 

[Ali Mohamed Ali]

عمل ممتاز استاذ محمد بارك الله فيك وزادك الله من فضله

[أ / محمد صالح]

رائع دائما بشمهندس @محمد طاهر

وكود بسيط ورائع جدا

تقبل تحياتي

[moneer saad]

عمل ممتاز استاذ محمد

 

[محمد طاهر عرفه]

شكرا علي كلماتكم الطيبة 🌷

[أحمد يوسف]

أحسنت استاذ محمد جزاك الله كل خير وزادك الله من فضله

[محمد طاهر عرفه]

تم اضافة الاصدار الثاني من الملف و هو يحوي كود اضافي لاعادة الوضع لما كان عليه

اي تحويل البلوكات الرأسية مرة أخرى إلى أفقية

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