استخراج القيم الفريدة من عمودين وترتيبها

[الساحر NeT]

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

معلمينا الافاضل أتوجه إليكم بخالص الشكر علي ماقمتم به من علم لنا والحمد لله افادني كثيرا وأرجو من الله ان يجعله في ميزان حسناتكم جميعا 

فضلا من حضراتكم 

قمت باستخراج القيم المفردة من عمود ال عمود 

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

لكني اريد استخراج هذه القيم من عمودين في عمود واحد مع ترتيبها 

يوجد مثال بالمرفقات

شكرا لكم 

استخلاص الاصناف المنفردة من عمودين وترتبيها.xlsx

[سليم حاصبيا]

هذا عمل من الصعب تنفيذه بالمعادلات

جرب هذا الكود

Option Explicit

Sub Extract_Codes()
Dim col As Object
Dim i%
Dim RoB%, RoD%
Set col = CreateObject("System.Collections.ArrayList")
With Sheets("Sheet2")
    i = 2
      Do Until .Cells(i, 1) = vbNullString
       If Not col.Contains(.Cells(i, 2).Value) _
         And .Cells(i, 2) <> "" _
         And IsNumeric(.Cells(i, 2)) Then
         col.Add .Cells(i, 2).Value
        End If
       If Not col.Contains(.Cells(i, 4).Value) _
        And .Cells(i, 4) <> "" _
        And IsNumeric(.Cells(i, 4)) Then
         col.Add .Cells(i, 4).Value
        End If
      i = i + 1
    Loop
    col.Sort
    
    .Cells(1, "I").CurrentRegion.ClearContents
    .Cells(1, "I").Resize(col.Count).Value = _
     Application.Transpose(col.ToArray)
 End With
 
End Sub

الملف مرفق

Saher.xlsm

[الساحر NeT]

اخي الحبيب سليم 

عند تشغيل الملف والضغط على Run 

يظهر كما في الصوره 

[سليم حاصبيا]

لا أعلم ما المشكلة عندك ربما يكون اصدار الاوفيس قديماً

عتدي يعمل الماكرو بشكل طبيعي

جرب تبدل هذا السطر     %Dim i 

الى   #Dim i

 

[الساحر NeT]

نفس المشكلة اخى سليم 

مع اني قمت بتغيير الشيت بعمل ملف جديد ووضع الكود وحصل نفس الخطأ 

[سليم حاصبيا]

الظاهر ان المشكلة عندك في الــ  Windows
جرب ان تنفذ الماكرو من جهاز اخر او دع احد غيرك   يحمل الملف ويجربه

[هانى محمد]

لديك حق استاذ سليم ... فقد قمت سابقاً بتحميل الملف , والملف يعمل معى بكل كفاءة ويستخرج القيم المطلوب بكفاءة عالية ... بارك الله فيك استاذنا الكريم

حقاً وصدقاً كده تكون المشكلة لدى صاحب المشاركة وأعتقد ان طلبه قد تم ويجب غلق المشاركة لعدم تشتيت الأساتذة والخبراء

[الساحر NeT]

تمام شكرا لاهتمامك وتفاعلك اخى سليم

جزاك الله خير الجزاء على تعبك معى