فرز عمود إلى أعمدة مجاورة

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

وهذا حل آخر بدالة معرفة

Function GetElement(Text As Variant, N As Integer, Delimiter As String) As String
'تقوم الدالة المعرفة بفصل البيانات بناءً على فاصلة تحددها
'يمثل البارامتر الأول النص أو البيان المراد فصل بياناته
'يمثل البارامتر الثاني رقم البيان المراد فصله أي موقع البيان المراد فصله
'يمثل البارامتر الثالث نوع الفاصل بين الكلمات أو البيانات
'=GetElement($B5,COLUMN(A1),",")
'--------------------------------------------------------------------------------
    Dim Txt, Str As String
    Dim Count, I As Integer
    Txt = Text
    If Delimiter = Chr(32) Then Txt = Application.Trim(Txt)
    
    If Right(Txt, 1) <> Delimiter Then
        Txt = Txt & Delimiter
    End If
    Count = 0
    Str = ""
    
    For I = 1 To Len(Txt)
        If Mid(Txt, I, 1) = Delimiter Then
            Count = Count + 1
            If Count = N Then
                GetElement = Str
                Exit Function
            Else
                Str = ""
            End If
        Else
            Str = Str & Mid(Txt, I, 1)
        End If
    Next I
    GetElement = ""
End Function

عشان متقولش إني حارمك من حاجة يا أبو سليمان

Split Data UDF Function YasserKhalil.rar

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

وهذا حل ثالث بدالة معرفة أيضاً

Function MySplitFunction(myStr As String, ref As Long)
'=IFERROR(MySplitFunction($A1,COLUMN(A1)),"")
    MySplitFunction = Split(Application.Trim(myStr), ",")(ref - 1)
End Function

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

وبكدا يكون الأخ صلاح قدم لك حل بالمعادلات ، والعبد لله قدم لك حل بالكود ، وحلين بالدوال المعرفة ..(نقي واختار .. وسلم لي على مختار)

Split Data UDF Function YasserKhalil V2.rar

[ا بو سليمان]

العمود a يا ابو اليسر العمود ضيق وسع العمود

 

عنك انت الطالعة دى

 

لعله يكون المطلوب

احسن ا لله   اليك دنيا و اخره 

 

ممتاز   سوف احاول الطبيق  وارى نتائجها   وامكانية  تطبيقها على بقيه الملفات 

[ا بو سليمان]

عموماً يا مستر صلاح

مش هسيبك تطلع الطلعة دي لوحدك

بناءً على ملفك وليس ملف الأخ أبو سليمان ..إليك الكود التالي ..

Sub SplitData()
    Dim I As Long, J As Long, SP
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
        For I = 5 To Cells(Rows.Count, 2).End(xlUp).Row
            SP = Split(Cells(I, "B"), ",")
            For J = LBound(SP) To UBound(SP)
                Cells(I, J + 3) = SP(J)
            Next J
        Next I
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

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

 

اخي  يااااااااسر..  انت  شوفت  كيف لما يتكلم معك  شخص   زيك  محترف     مش  مثل لما انا  الغلبان  اتحكلم معاك  ومش عارف ازاي اوصل المعلووووومة 

 

بارك الله فيك وفي  علمك  

[ا بو سليمان]

سوف اطبق ما ورد في الاجابات السابقة  وان  شاء الله   يتم الحل  

 

مع العلم انني ارى  ان  بعض الارقام  في خانة الحجم   فيها علامة   غير الارقام  ..........!!!!

[ا بو سليمان]

طبعا بعد  هذه الخطوات  فيه  اشياء مطلوبه وهي 

 

الملف الاصلي يكون  في مجلد    ونفترض ان  مجلد رقم  1

 

ارغب بان  يكون فيه مجلد ثاني  وهو الذي سوف يتم العمل عليه  ونفترض ان اسمة مجلد رقم  2

 

الان  ارغب جلب   بيانات  كل شركة   من الملف الاول الى الملف الثاني        ويكون  نقل البيانات   بناء على اسم الشركة  ( 1010  و  1020 و  1030  ......وهكذا  )

 

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

 

 

 

(( يعني  الخلاصة  ))

 

المجلد  رقم   1  البيانات الاصليه     متغيره    ممكن احذفها   او الصقها مره ثانية  في نفس المجلد ........ هذا لا يؤثر على المجلد رقم  2

 

والسبب انه  المجلد رقم  2  يجلب البيانات التي  في المجلد رقم  1  متى ما كان فيه بيانات 

 

 

الرجاء من الاخوه الكرام   ربط الحززززام   ههههههه     

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

أخي أبو سليمان

المسميات هامة جداً ..ماذا تقصد بالمجلد ..هل تقصد المجلد أي المجلد أم المجلد تقصد به المصنف

رأيي أن تحصل على نتائج لملف واحد الآن حتى يطمئن قلبك أن النتائج صحيحة 100% بعدها يمكنك طرح موضووع جديد وترفق فيه الكود الذي أعجبك وتطلب الإضافة عليه أو تطبيقه على عدد من المصنفات

 

وربنا يكفينا شر المنغصات