المساعدة في تلخيص عمود

[م.مهند القانوع]

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

‫تجريب - نسخة.rar

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

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

[م.مهند القانوع]

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

‫تجريب - نسخة.rar

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

جرب هذا الشيء

 

‫تجريب - نسخة salim.rar

[م.مهند القانوع]

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

[م.مهند القانوع]

اخى الفاضل سليم

لاستكمال البرنامج ارجو المساعدة في كيقية عمل فرز تلقائي كلما اختلفت البيانات بدون اللجوء الى الفرز اليدوي في كل مرة تختلف فيها البيانات .

التوضيح في الملف المرفق

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

‫تجريب - نسخة.rar

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

تفضل المطلوب 

اضغط (افضل اجابة) اذا كان الامر كذلك

‫تجريب - نسخة 1.rar

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

الأخ الكريم

يرجى تغيير اسم الظهور للغة العربية

 

بعد إذن أخي الحبيب سليم وإثراءً للموضوع

إليك حل بالأكواد عله يفي بالغرض .. تم الفرز على أساس العمود M

Sub ExtractUniqueAndSort()
    Dim lRow As Long
    Dim Element As Variant
    Dim Dict As Object
    Dim J As Long
    Set Dict = CreateObject("Scripting.Dictionary")
    
    With ThisWorkbook.Worksheets("2")
        .Columns("K:M").ClearContents
        For lRow = 1 To 100
            If Len(.Cells(lRow, 1)) Then
                If Not Dict.exists(.Cells(lRow, 1).Value) Then
                    Dict.Add .Cells(lRow, 1).Value, 1
                    J = J + 1
                    .Cells(J, 11).Resize(, 3).Value = .Cells(lRow, 1).Resize(, 3).Value    '***
                End If
            End If
        Next lRow
        Set Dict = Nothing
    End With
    Set Dict = Nothing
    
    With Range("K1:M1").CurrentRegion
        .Sort Key1:=.Cells(1, 3), Order1:=xlAscending
    End With
End Sub

تقبل تحياتي

Unique Values & Sort YasserKhalil.rar

[م.مهند القانوع]

تفضل المطلوب 

اضغط (افضل اجابة) اذا كان الامر كذلك

جهد مبارك و اشكرك اخى سليم على الاهتمام و اتمنى منكم المتابعة حتى تعم الفائدة ....و نستكمل فكرة البرنامج .

 قمت اخى بتلخيص قاعدة البيانات و حذف الفراغات و بالاضافة الى ذلك مطلوب الفرز في العمود M كما هو موضح في الملف المرفق .

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

‫تجريب - نسخة 2.rar

[م.مهند القانوع]

 

الأخ الكريم

يرجى تغيير اسم الظهور للغة العربية

 

بعد إذن أخي الحبيب سليم وإثراءً للموضوع

إليك حل بالأكواد عله يفي بالغرض .. تم الفرز على أساس العمود M

Sub ExtractUniqueAndSort()
    Dim lRow As Long
    Dim Element As Variant
    Dim Dict As Object
    Dim J As Long
    Set Dict = CreateObject("Scripting.Dictionary")
    
    With ThisWorkbook.Worksheets("2")
        .Columns("K:M").ClearContents
        For lRow = 1 To 100
            If Len(.Cells(lRow, 1)) Then
                If Not Dict.exists(.Cells(lRow, 1).Value) Then
                    Dict.Add .Cells(lRow, 1).Value, 1
                    J = J + 1
                    .Cells(J, 11).Resize(, 3).Value = .Cells(lRow, 1).Resize(, 3).Value    '***
                End If
            End If
        Next lRow
        Set Dict = Nothing
    End With
    Set Dict = Nothing
    
    With Range("K1:M1").CurrentRegion
        .Sort Key1:=.Cells(1, 3), Order1:=xlAscending
    End With
End Sub

تقبل تحياتي

اشكرك اخى ياسر على الاهتمام و فعلا الكود رائع جدا و لكن عندما قمت بتطبيق الكود على قاعدة بيانات تتكون من 38 صف قام بفرز 35 فقط و التوضيح في الملف المرفق

Unique Values & Sort YasserKhalil11.rar

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

الأخ الفاضل مهند القانوع

جرب الكود بهذا الشكل

Sub ExtractAndSort()
Dim lRow As Long
Dim J As Long

With ThisWorkbook.Worksheets("2")
.Columns("K:M").ClearContents
For lRow = 1 To 100
If Len(.Cells(lRow, 1)) Then
J = J + 1
.Cells(J, 11).Resize(, 3).Value = .Cells(lRow, 1).Resize(, 3).Value
End If
Next lRow
End With

With Range("K1:M1").CurrentRegion
.Sort Key1:=.Cells(1, 3), Order1:=xlAscending
End With
End Sub

[م.مهند القانوع]

اخى الكريم الكود لا يعمل نأمل منكم تحميل الكود على الملف و تجربته

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

تفضل أخي الملف التالي

Extract Values Skipping Blanks & Sort YasserKhalil.rar

[محمد الريفى]

السلام عليكم

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

هذه معادله معادلة صفيف لابد من الضغط بعد الانتهاء على ctrl+shift+enter

=IFERROR(INDEX($B$1:$B$38;MATCH(SMALL(IF(ISERROR($B$1:$B$38);"";ROW($B$1:$B$38));ROW(A1));ROW($B$1:$B$38);0));"")

_تجريب - نسخة.rar

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

أخي الحبيب محمد الريفي ...

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

 

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

والمطلوب على ما يبدو لي : استخراج كل القيم من الثلاثة أعمدة بدون فراغات ثم ترتيب البيانات حسب العمود الثالث في النتائج المستخرجة

[م.مهند القانوع]

أخي الحبيب محمد الريفي ...

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

 

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

والمطلوب على ما يبدو لي : استخراج كل القيم من الثلاثة أعمدة بدون فراغات ثم ترتيب البيانات حسب العمود الثالث في النتائج المستخرجة

الاخوة الاحباب في موقع اوفيسنا العظيم تقبل الله منا و منكم صالح الاعمال و كل عام و انتم بالف الف خير

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

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

[م.مهند القانوع]

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

test.rar