اذهب الي المحتوي
أوفيسنا

تقسيم محتوى عمود فى الاكسل الى عدة اعمدة


إذهب إلى أفضل إجابة Solved by محي الدين ابو البشر,

الردود الموصى بها

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

الف شكر للكل من يمد يد المساعدة فى هذا المنتدى الرائع الذى يفيد قطاع عريض من المحتاجين للمساعدة

لدى قاعدة بيانات كبيرة جدا تتكون من 12000 صفحة بدى اف وبها اسماء اكثر من 500000 اسم

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

وهل نستطيع تلوين كلمة معينة مثل كلمة العمار

لكم جزيلا الشكر على المساعدة مقدما

المصنف1.xlsm

رابط هذا التعليق
شارك

السلام عليكم

ربما

تم التقسيم حسب الجدول 

Sub test()
    Dim m As Object, a, i, ii
    a = Range("a2").Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1)
    ReDim b(1 To UBound(a), 1 To 5)
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(\d+){1,2}|(\W+)"
        For i = 1 To UBound(a)
            Set m = .Execute(a(i, 1))
            For ii = 1 To 3
                b(i, ii) = m(ii - 1)
            Next
            b(i, 4) = Split(Trim(m(ii - 1)))(0)
            b(i, 5) = Mid(Trim(m(ii - 1)), Len(b(i, 4)) + 1)
        Next
    End With
    c = 0: cc = 1
    For x = 1 To UBound(b) Step 22
        [b2].Offset(, cc + c - 1).Resize(22, 5) = Application.IfError _
                                                  (Application.Index(b, Evaluate("row(" & x & ":" & x + 22 & ")") _
                                                                        , Array(1, 2, 3, 4, 5)), "")
        c = c + 1: cc = cc + 4
    Next
End Sub

 

  • Like 3
  • Thanks 2
رابط هذا التعليق
شارك

اولا الف شكر على المساعدة

ثانيا الكود يعمل اى عدد والحمد لله

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

لا اعرف سبب هذه المشكلة هل من عندى ام من الكود وكمان بيكرر بعض الاسماء فى العمود

g ,h ,i ,k

image.png.7641836b9bbbe69b34bd04dafddb3ac3.png

نسخة من المصنف199999.xlsm

رابط هذا التعليق
شارك

السلام عليكم

آسف على التأخير

إليك الملف بزيادة الصفوف إلى 100 و تعديل الكود 

 [b2].Offset(, cc + c - 1).Resize(100, 5) = Application.IfError _
                                                  (Application.Index(b, Evaluate("row(" & x & ":" & x + 100 & ")") _
                                                                        , Array(1, 2, 3, 4, 5)), "")

هناك بعض المشاكل في عملية النسخ  لا يمكن للكود التعامل معها وسيتم تلوينها باللون الأحمر وستظهر فراغات في الجداول

وفي حال تم تصحيح الأخطاء  بإعادة تنفيذ الكود سيتم ما هو مطلوب 

المصنف99.xlsm

رابط هذا التعليق
شارك

الف شكر على الاستجابة والمتابعة جزاك الله كل خير

عند لصق بعض الاسماء تظهر هذه الرسالة باللون الاصفر

b(i, 4) = Split(Trim(m(ii - 2)))(0)

والكود به رقم22 وفى البعض 100 هل هذا يؤثر على عمل الكود

image.png.6ff3ec7fb4cdcd0198f0c9e53cbb858d.png

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

رابط هذا التعليق
شارك

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

 

الكود توقف عن العمل وهل يوجد معادلة تحل محل الكود تكون بديل له لو تعطل

نسخة من المصنف99-1.xlsm

image.png.8a9ae832bb8a067fb9289f209f0ff142.png

رابط هذا التعليق
شارك

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information