طريقة تحويل عمود الى جدول بشروط معينة ؟

[obaid70]

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

السادة الخبراء 

ارجو مساعدتي في حل هذه المعضلة (بالنسبة لي طبعا) وهي تحويل عمود الى جدول 

الفكرة هي اريد نسخ جميع البيانات بين (المدرسة) و (رقم الاكتتاب) ووضعها في عمود (رقم الاكتتاب) وكذلك نسخ البيانات بين (رقم الاكتتاب) و (الاسم) ووضعها في عمود (الاسم) وهكذا الى آخر البيانات

طبعا العمود هو اطول بكثير مما هو موجود في هذا المثال 

هل يمكن حل الموضوع جزاكم الله ألف خير

تحويل عمود.xlsx

[محي الدين ابو البشر]

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

ربما

Sub Test()
    Dim x, h
    Dim i&, c&
    Dim ar As Range
    With [a:a]
        .ClearContents
        .Interior.Color = xlNone
    End With
    h = Range("f1").Resize(, 9)
    For Each ar In Range("F1").CurrentRegion.SpecialCells(4).Areas
        x = ar.Offset(-1).Resize(ar.Count + 1, 9)
        For i = 2 To UBound(x, 2)
            If i = 2 Then Cells(3, 17).Offset(c) = IIf(i = 2, x(i - 1, 1), h(1, i - 1))
            With Cells(3, 1)
                .Offset(c + 1) = h(1, i - 1)
                .Offset(c + 1).Interior.Color = vbYellow
                .Offset(c + 2).Resize(UBound(x)) = Application.Index(x, Evaluate("row(1:" & UBound(x) & ")"), i)
            End With
            c = c + UBound(x) + 1
        Next
        Cells(3, 1).Offset(c + 1) = h(1, i - 1)
        c = c + 2
    Next
End Sub

 

تم تعديل ديسمبر 6, 2023 بواسطه محي الدين ابو البشر

[obaid70]

جزاكم الله الف خير 

وشكرا على الرد السريع

استاذ محي الدين ظهرت لدي هذه الرسالة

[محي الدين ابو البشر]

من الصورة أعلاه يبدو أنها غير الملف الذي ارسلته في المشاركة الأولى!!!

مع العلم أن الكود يعمل على ملفك جيداً

أو ممكن أن نحاول استبدال السطر 

  With Columns(1)بـWith [a:a]

تم تعديل ديسمبر 6, 2023 بواسطه محي الدين ابو البشر

[obaid70]

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

لكن هذه النتيجة على الملف القديم

نفس الشيء

هل يوجد طريقة خاصة لوضع الكود وتشغيله ؟

 

[محي الدين ابو البشر]

تحويل عمود .xlsm

[obaid70]

اشكرك استاذ محي الدين على المتابعة

لكن يبدو ان الفكرة غير واضحة

ما اريده من الماكرو هو نسخ البيانات من العمود A الى الجدول

لاحظ استاذي بعد افراغ الجدول و تشغيل الماكرو ماذا حصل 

قام الماكرو بمسح الحقل بالكامل

[محي الدين ابو البشر]

فهمت الموضوع غلط

آسف عل الـ MIS UNDERSTANGIG

[obaid70]

ولا يهمك استاذي

انا ممنون منك على تجاوبك معي

تعرف استاذي اذا انحل هالموضوع بتريحني من عمل اسبوع كامل لاني عم اشتغل الموضوع بطريقة يدوية 

وفقكم الله

وجزاكم الف خير

[محي الدين ابو البشر]

عسى يكون المطلوب

 

تحويل عمود (1).xlsm

[obaid70]

كم انت رائع استاذ محي الدين

لكن هناك مشكلة وهي ان البيانات ليست دائما بنفس العدد

بمعنى آخر اول مجموعة عدد السجلات 15 سجلا

والمجموعة الثانية هي 11 سجلا

طبعا انا غيرت بالبيانات لاختبر الماكرو فظهرت لدي هذه المشكلة

[محي الدين ابو البشر]

لم تذكر ما هي التغييرات مع ذلك

 

تحويل عمود (1).xlsm

[obaid70]

انا آسف جدا استاذي الكريم سامحني بتعبك

لكن ممكن اعرف ليش ظهرت هالفراغات

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

ومره اخرى سامحني بتعبك

 

تحويل عمود 4.xlsm

تم تعديل ديسمبر 7, 2023 بواسطه obaid70

[obaid70]

للرفع

[محي الدين ابو البشر]

هذا آخر ملف لك مع الكود المنقح ويعمل جيداً 

بعد الأخذ بعين الاعتبار الملاحظة التالية إذا سمحت لي:

حسب العمود الأول لديك 

دائما تبدأ بـ اسم المدرسة ثم "المدرسة" ، أرقام الكتتاب ثم "رقم الاكتتاب" ..... وفي النهاية الديانات  ثم "الديانة" هذا الكلام جميل ولا غيار عليه

ولكن لا أدري لماذا  في بعض المدارس يختلف الترتيب  في الديانات "الديانة" ثم الديانات 

جرب الملف المرفق مع التعديل عسى يناسبك

 

 

تحويل عمود 4 معدل.xlsm

[obaid70]

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

عمل ممتاز جدا

بالنسبة للديانة مافي مشكلة فيني استغنى عن الحقل

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

استاذي قد يصل العمود الى 10000 سجل وليس فقط هذه السجلات الموجودة حاليا

وانا ممنون منك كتير وشاكر فضلك

وخبزاك الله ألف خير

[محي الدين ابو البشر]

   يمكن تعديل السطر 

ReDim a(1 To 100, 1 To 2)

إلى 

   

 ReDim a(1 To 1000, 1 To 2)

و أخبرني بالنتيجة

بالتوفيق

تم تعديل ديسمبر 10, 2023 بواسطه محي الدين ابو البشر

[obaid70]

جزاكم الله الف خير وجعله في ميزان حسناتكم

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

 

[محي الدين ابو البشر]

بارك الله