ارجو المساعدة لعمل ترتيب بشكل معين بالكود او بالمعادلات

[فضل حسين]

الى خبراء واعضاء منتداى العزيز والعظيم

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

كل عام وانتم بخير

مرفق ملف موضح به المطلوب

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

 

ترتيب بشكل معين.rar

[الخالدي]

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

اخي الكريم

جرب الكود التالي

Sub AL_KHALEDIفرزمخصص()
Set Rn1 = [A1]
Set Rn2 = [D1]
Set Rn1 = Range(Rn1, Rn1(Cells(1000, Rn1.Column).End(xlUp).Row, 1))
CLC1 = Application.CustomListCount
Application.AddCustomList ListArray:=Rn1
On Error GoTo Error:
CLC2 = Application.CustomListCount
L1 = Cells(Rows.Count, Rn2.Column).End(xlUp).Row
Set Rn3 = Range(Rn2, Rn2(L1, 1))
Dim Arr()
For Each Rc1 In Rn1.Cells
If Application.CountIf(Rn3, Rc1) = 0 Then
ReDim Preserve Arr(L2)
Arr(L2) = Rc1.Value
L2 = L2 + 1
Rn2(L1 + L2, 1).Value = Rc1.Value
End If
Set Rn3 = Range(Rn2, Rn2(L1 + L2, 1))
Next Rc1
Rn3.Sort Rn3(1, 1), xlAscending, Header:=xlNo, OrderCustom:=CLC2 + 1
For Each Rc3 In Rn3.Cells
If Not IsError(Application.Match(Rc3, Arr, 0)) Then Rc3.Value = ""
Next Rc3
Error:
If CLC2 > CLC1 Then
Application.DeleteCustomList ListNum:=CLC2
End If
Set Rn1 = Nothing: Set Rn2 = Nothing: Set Rn3 = Nothing
Erase Arr
End Sub

في امان الله

[عبدالله باقشير]

السلام عليكم

 

تم العمل بالكود التالي:

Const Adr As String = "I13"
Sub Macro1()
Dim Rng1 As Range, Rng2 As Range, Cel As Range
Dim R As Integer
Set Rng1 = Range("A1:A11")
Set Rng2 = Range("D1:D11")

For Each Cel In Rng1
    R = R + 1
    If WorksheetFunction.CountIf(Rng2, CStr(Cel)) Then
        Range(Adr).Cells(R, 1).Value = Cel.Value
    End If
Next
For Each Cel In Rng2
    If WorksheetFunction.CountIf(Rng1, CStr(Cel)) = 0 Then
        R = R + 1
        Range(Adr).Cells(R, 1).Value = Cel.Value
    End If
Next
End Sub

شاهد المرفق 2003

ترتيب بشكل معين.rar

[الـعيدروس]

السلام عليكم

الاستاذ الخالدي حفظك الله

وحشتنى اعمالك يارجل

اسأل الله ان تكون بأحسن حال

كود في قمة الاحتراف

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

تقبل مروري

[الـعيدروس]

حيا ومرحبا استاذ عبدالله باقشير

كذا الاخ فضل محضوظ جداً

لمشاركة الاساتذه الكبار في موضوعه

كود مختصر جزاك الله خيراً

تحياتي وشكري للجميع

في امان الله

[عبدالله باقشير]

السلام عليكم

اخي الحبيب الخالدي .......لم اشاهد مشاركتك

عموما زيادة في الخير ............جزاكم الله خيرا.....تقبلوا تحياتي وشكري

 

اخي الحبيب عباد..........جزاكم الله خيرا.....تقبلوا تحياتي وشكري

[فضل حسين]

الاستاذ الفاضل / الخالدى باشا ...................... صاحب الاعمال الرائعة والجميلة

العالم الكبير / عبدالله باقشير  ........................ عالمنا الجليل وصاحب الافكار المبهرة

عمل رائع لاستاذان كبيران كنت محظوظ بمشاركتهم .

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

دائما تمتعونا باعمالكم الجميلة مثلكم 

الف شكر على حلكم الرائع 

جزاكم الله كل خير ودائما تمتعونا بأعمالكم الخالدة والممتعة 

وشكرا