الترتيب التلقائي

[ashehry2000]

الخبراء الأفاضل : السلام عليكم ورحمة الله وبركاته وبعد،،،،،

طلبي اليوم هو كالتالي

جدول موجود فيه مجموعة من الشركات والمبالغ التي يتم تحصيلها كل شهر مثلاً ، وطلبي هو معرفة طريقة تساعد على عمل فرز تلقائي بمجرد إدخال المبلغ والإنتقال إلى أي خلية أخرى يتم عمل فرز آلي للجدول بالكامل بحيث يصبح المبلغ الأقل في الأول.

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

أبو أبرار

[ابومؤنس]

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

لنفرض ان العمود A كان مخصص للاسماء وان العمود B مخصص للمبالغ .

ضع الكود التالي في صفحة محرر الفيجول للورقة المراد فرزها تلقائيا وذلك ضمن Woorksheet عند الامر Change .

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("B" & Target.Row).Value > 0 Then
Columns("A:B").Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub

مع ملاحظة ان الفزر يعتمد علي المبالغ المسجلة في العمود B وهو يشمل العمودين A و B فقط .

غير رقم العمود B الي اي عمود اخري ,

بالتوفيق ,,,

[mr_looking]

الاخ ابو مؤنس

طبقت الكود الذي وضعته وتم فرز الاسماء ابجدياً بشكل ممتاز الله يعطيك العافية

ولكن برزت مشكلة اخرى وهي عند ادخال اسم جديد وضغط انتر للذهاب الى الخلية

التي تليها نجد انه يقوم بتضليل كامل النطاق مثلا من العمود a الى العمود b ونقل

المؤشر الى الخلية a1 وبالتالى تضظر الى استخدام الفارة لوضع المؤشر عند الخلية

المراد ادخال اسم جديد فيها !

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

والله يعطيك العافية مقدماً

تحياتي,,

[محمد حجازي]

السلام عليكم ...

اضف السطر التالي قبل End If :

Me.Cells(Me.Range("A1").CurrentRegion.Rows.Count + 1, 1).Select

بالتوفيق

[mr_looking]

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

الحقيقه استفت منه وحل جزء من مشكلتي واصبح لا يتم

واصبح لايتم تحديد كامل النطاق والكن المشكلة الاخرى التى اريد حلاًلها

هي ان يبقى المؤشر على نفس الخلية التي كنت اعمل عليها قبل ادخال الحدث

بمعنى اقوم بادخال الاسم ويتم الفرز ويبقى المؤشر على نفس الخلية التى اعمل

عليها ولا يتم نقله الى خلية اخرى

والله يعطيك العافيه اخوى محمد

انتظر ردك

تحياتي لك عزيزي محمد

[محمد حجازي]

السلام عليكم ...

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

Private Sub Worksheet_Change(ByVal Target As Range)
  If Me.Cells(Target.Row, 2).Value > 0 Then
    Me.Columns("A:B").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End If
End Sub

المشكلة السابقة كانت تكمن في تنشيط الهدف قبل فرزه ، راجع الرابط التالي :

http://www.officena.net/ib/index.php?showtopic=5827

بالتوفيق

[mr_looking]

الله يعطيك العافيه والله وابجرب الكورد واعطيك خبر انشاء الله

شكرا على الرد