محمد حسن المحمد

موعظـــــــــــــــــــــــــــــــــــــــــة أعطى أب لإبنه يوماً كيساً مليئاً بالمسامير وقال له: ( يا بني كلما اهنت شخص أو ضربت شخص أو جرحت شخص اذهب إلى سور الحديقة واطرق فيه مسماراً ) لم يفهم ذلك الولد لماذا طلب والده منه ذلك ولكنه امتثل لأمر والده وأصبح كلما يظلم أحداً أو يصرخ بوجه أحد أو يجرح أحداً يطرق مسماراً في ذلك السور ومع مرور الأيام أصبح الولد أكثر تحكماً في نفسه وانخفض عدد المسامير التي يطرقها كل يوم في السور إلى أن وصل اليوم الذي لم يطرق فيه ذلك الولد أي مسمار في السور فطار الولد من شدة الفرح وذهب إلى والده واخبره بذلك قال له والده: ( أحسنت يا بني أنت الآن شخص تتحكم في نفسك وفي أعصابك ولكن مهمتك لم تنته بعد ) استغرب الولد وقال: وماذا افعل بعد ذلك يا أبي ؟؟؟ قال الأب: ( كل يوم يمضي ولا تزعج أو تجرح أو تظلم فيه أحداً انزع مسماراً من ذلك السور مضت الأيام واستمر الولد في نزع المسامير في كل يوم لا يؤذي فيه أحداً إلى أن وصل اليوم الذي نزع فيه الولد آخر مسمار في ذلك السور فطار الولد من الفرح وذهب إلى والده ليخبره بذلك وعندما أخبره أخذ الأب ابنه إلى السور وقال أحسنت يا بني فأنت لم تصبح شخص متحكم في أعصابك فقط ولكنك أصبحت شخص طيب ولا تؤذي أحداً ولكن انظر إلى الثقوب في السور التي خلفتها تلك المسامير ……… لقد استطعت يا بني أن تنزع المسامير التي طرقتها ولكنك لا تستطيع محو تلك الثقوب التي تركتها المسامير !!! وكذلك هم البشر يا بني عندما تجرح أحدهم فأنت تطرق مسماراً في قلبه قد تستطيع أن تعتذر وتنزع ذلك المسمار ولكنك لن تنزع أثره وسيبقى ذكرى مؤلمة في حياة ذلك الشخص . لذلك يا بني لا تجرح الآخرين أو تؤذيهم بكلماتك فإنك لن تستطيع محو ذلك الجرح إلى الأبد ..

السلام عليكم إن صح عملي بنصيحتك يكون الكود على الشكل التالي: "والله أعلم" Sub SortByLEN() Application.ScreenUpdating = False With Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row) .FormulaR1C1 = "=LEN(RC[-1])" Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row).Sort Key1:=Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row), Order1:=xlDescending, Header:=xlNo .ClearContents End With Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله وبركاته أخي الحبيب أبو البراء وهذا كود آخر بحثت عنه وأضمه إلى باقتكم العطرة لكنني أود مراجعة آخر نقطة وقفت عنها لأنني لم أدركها ولم أستطع تطبيقها ... Sub kTest() Dim Rng As Range Application.ScreenUpdating = 0 Columns(1).Insert: Rows(1).Insert [a1] = "temp": [b1] = "texts" Set Rng = Range("a1", Range("b" & Rows.Count).End(xlUp)) With Rng .Offset(1).Resize(.Rows.Count - 1, 1).Formula = "=len(b2)" .Sort .Cells(2, 1), xlDescending, Header:=xlNo .Columns(1).Delete .Rows(1).Delete End With Application.ScreenUpdating = 1 End Sub

بارك الله بإخوتي الكرام الذين شاركونا هذا الموضوع ...الحمد لله ...الخير بأمة محمد إلى يوم القيامة... والسلام عليكم.

السلام عليكم أخي الحبيب أبو البراء ...جزاكم الله خيراً..عمل مميز

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

هل يتم ذلك بإيقاف تحديث الشاشة ثم إعادة تحديثها بعد تنفيذ الكود ...يرجى الإفادة. وأما المدى الديناميكي ...أكيد بحاجة دراسة.

أحب ذلك بشكل أكيد ولكن عذري أن دوامي قارب على الانتهاء ...فأنا شغوف للتعلم منكم لأن به بركة وإن شاء الله الألزهايمر ما يضيعهم من ذاكرتي العجوز.

Sub SortByLEN() With Range("B1:B10") .FormulaR1C1 = "=LEN(RC[-1])" Range("A1:B10").Sort Key1:=Range("B1:B10"), Order1:=xlDescending, Header:=xlNo .ClearContents End With End Sub السلام عليكم ورحمة الله وبركاته ..هذا ما توصلت إليه أخيراً ...وقد عمل بشكل صحيح والسلام عليكم أتعبتكم معي...سامحوني.

للأسف لم يتم الفرز بهذه الطريقة Sub SortByLEN() With Range("A1:B10") .FormulaR1C1 = "=LEN(RC[-1])" .Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlNo .ClearContents End With End Sub

المشكلة في هذا السطر Range("A1:B10").Sort Key1:=Range("B1:B10"), Order1:=xlDescending, Header:=xlNo Sub SortByLEN() With Range("A1:B10") .FormulaR1C1 = "=LEN(RC[-1])" .Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlNo .ClearContents End With End Sub يرجى المساعدة بتصحيحه..جزاكم الله خيراً.

السلام عليكم أخي الحبيب أبو البراء تأخرت عليك لا تؤاخذني.. Sub SortByLEN() Range("B1:B10").FormulaR1C1 = "=LEN(RC[-1])" Range("A1:B10").Sort Key1:=Range("B1:B10"), Order1:=xlDescending, Header:=xlNo Range("B1:B10").ClearContents End Sub بارك الله بكم وبعلمكم ونفع به وجعله ذخراً لكم يوم القيامة ..آمين.

السلام عليكم أخي الحبيب أبو حمزة...ربنا يبارك لكم بحمزة ومن معه ...آمين درر سنية تتحفنا بها لتجعل يومنا عامراً بالتفاؤل ...جزاكم الله خيراً وأحسن إليكم...والسلام عليكم.

السلام عليكم ...تم التعديل ..جزاكم الله خيراً

السلام عليكم ورحمة الله وبركاته أخي الحبيب أبو البراء...أرجو أن يكون حلاً مناسباً بعد جهد جهيد...العلم في الصغر كالنقش في الحجر ..أما في الكبر فهو كوخز الأبر.. Sub SortByLEN() Range("B1").Select Range("B1").FormulaR1C1 = "=LEN(RC[-1])" Selection.AutoFill Destination:=Range("B1:B10") Range("A1:B10").Sort Key1:=Range("B1:B10"), Order1:=xlDescending, Header:=xlNo Range("B1:B10").ClearContents End Sub فرز حسب الأحرف تنازلياً.rar

السلام عليكم إن شاء الله تعالى بعد صلاة الجمعة

السلام عليكم طبقت ما ذكرت لي بموديول عن طريق تسجيل ماكرو أرجو أن ينال إعجابكم فرز حسب الأحرف تنازلياً.rar

السلام عليكم ورحمة الله وبركاته جزاكم الله خيراً على تفعيل العمل والطلب من الأعضاء الكرام التفاعل الإيجابي بالموارد المتاحة قمت بدوري بالفرز التنازلي حسب عدد الأحرف باستخدام عمود مساعد يتعلق بعمل الدالة LEN كمساهمة بسيطة والسلام عليكم. فرز حسب الأحرف تنازلياً.rar

السلام عليكم ورحمة الله وبركاته جزاكم الله خيراً أخي الحبيب أبو جودي على حسن ظنك بنا ...نِعْمَ الصاحب الساحب إلى الرضى والقبول إن شاء الله تعالى. أرجو أن يكون لنا جميعاً حظاً وسعداً في الصحبة الطيبة ...وأنا أيضاً وكما قال الإمام الشافعي رحمه الله أحب الصالحين ولست منهم -"أرجو أن نكون من الصالحين الناصحين"- لعلي أرتجي منهم يوم القيامة شفاعة... وفرق شاسع بين حامل المسك ونافخ الكير والسلام عليكم ورحمة الله وبركاته

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

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

السلام عليكم أخي الحبيب أبو صهيب. عمل رائع ...جزاكم الله خيراً...سأحاول تطبيق هذه المعادلة ضمن معادلات التكويد التلقائي لديّ إن شاء الله تعالى. والسلام عليكم ورحمة الله وبركاته

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