اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر (معدل)

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

عايز امر ماكرو لو الخلية O1 اقل من صفر يعنى بالسالب يلون من الخليه A1 الى الخليه O1 باللون الاحمر ويطبقها لحد O1000 يعنى من A1 الى O1000

ملاحظه : مش هاينفع عن طريق اداة conditional formatting عشان شيتات كتير جدااا عايز اطبق فيها الكلام ده تقريباً 20 ملف كل ملف اكسيل فيه 50 شيت

تم تعديل بواسطه محمد عبد الناصر
قام بنشر (معدل)

عسى ان يكون المطلوب

51 دقائق مضت, محمد عبد الناصر said:

تمام حضرتك دى انا عملتها سهله الى مش عارف اعملو انى عايزها عن طريق كود ماكرو مش هاينفع عن طريق conditional formattig عشان عندى 20 ملف اكسيل كل ملف فيه 60 شيت عايز اطبقها على كلو

 

 

 

جرب هذا الكود

Sub talween()
  For x = 1 To Sheets.Count
        With Sheets(x)
                ro = .Cells(Rows.Count, "O").End(3).Row
                     .Range("a1:o" & ro).ClearFormats
                   For Each cell In .Range("o1:O" & ro)
                        If IsNumeric(cell) And cell.Value < 0 Then
                          cell.Offset(0, -14).Resize(1, 15).Interior.ColorIndex = 3
                        End If
                  
                   Next
        End With
   Next
End Sub

 

تم تعديل بواسطه سليم حاصبيا
  • Like 5
قام بنشر

بجد شغل عالى اوى اوى اوى اوى متعرفش انت سهلت عليا مجهود تقريبا اسبوعين كان هايطلع عينى والله ربنا يجعلو فى ميزان حسناتك ان شاء الله

 

اخر حاجه لو عايز اغير لو مثلا اى خليه فى العمود M اغير انهى سطر وجزاك الله كل خير

قام بنشر
8 دقائق مضت, محمد عبد الناصر said:

بجد شغل عالى اوى اوى اوى اوى متعرفش انت سهلت عليا مجهود تقريبا اسبوعين كان هايطلع عينى والله ربنا يجعلو فى ميزان حسناتك ان شاء الله

 

اخر حاجه لو عايز اغير لو مثلا اى خليه فى العمود M اغير انهى سطر وجزاك الله كل خير

عسى ان يكون المطلوب

3 ساعات مضت, محمد عبد الناصر said:

تمام حضرتك دى انا عملتها سهله الى مش عارف اعملو انى عايزها عن طريق كود ماكرو مش هاينفع عن طريق conditional formattig عشان عندى 20 ملف اكسيل كل ملف فيه 60 شيت عايز اطبقها على كلو

 

 

 

جرب هذا الكزد

Sub talween()
ro = Cells(Rows.Count, "O").End(3).Row
Range("a1:o" & ro).ClearFormats
For Each cell In Range("o1:O" & ro)
 If IsNumeric(cell) And cell.Value < 0 Then
 
   cell.Offset(0, -14).Resize(1, 15).Interior.ColorIndex = 3
  
   End If
Next
End Sub

حاجة سهلة

كل شيء بالكود متعلق بالحرف O استبدله الى M

و استبدل الرقم 14- ب 12- و الرقم 15 ب 13

وأخيراً اين الاعجاب بالكود

  • Like 3
قام بنشر
31 دقائق مضت, محمد عبد الناصر said:

والله مش عارف اقولك ايه انت وفرت عليا مجهود كتير اوى كنت هاعملو فى ميزان حسناتك ان شاء الله

جرب حمل الكود الذي وضعته لنعرف المشكلة

قام بنشر (معدل)

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

هذا العبقري اسمه " سليم حاصبيا "

باسم الله ما شاء الله

بارك الله فيك أخي الغالي و أستاذي القدير على الأعمال الرائعة و الرّاقية التي تتحف بها دومًا منتدانا

فائق إحتراماتي

 

 

تم تعديل بواسطه عبد العزيز البسكري
  • Like 1
قام بنشر

هو هو الى حضرتك عملتو مفيش اى تغيير وعايزو يعملها على كل الشيتات الموجوده فى الملف انا مغيرتش اى حاجه فى الكود

Sub talween()
  For x = 1 To Sheets.Count
        With Sheets(x)
                ro = .Cells(Rows.Count, "O").End(3).Row
                     .Range("a1:o" & ro).ClearFormats
                   For Each cell In .Range("o1:O" & ro)
                        If IsNumeric(cell) And cell.Value < 0 Then
                          cell.Offset(0, -14).Resize(1, 15).Interior.ColorIndex = 3
                        End If
                  
                   Next
        End With
   Next
End Sub

 

قام بنشر
26 دقائق مضت, عبد العزيز البسكري said:

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

هذا العبقري اسمه " سليم حاصبيا "

باسم الله ما شاء الله

بارك الله فيك أخي الغالي و أستاذي القدير على الأعمال الرائعة و الرّاقية التي تتحف بها دومًا منتدانا

فائق إحتراماتي

 

 

مشكور جداً اخي غبد العزيز

ما اوتينا من علم ذلك بفضل هذا المنتدى الرائع

رجاء اذعب الى هذا العنوان اترى احد الابداعات الجديدة

 

4 دقائق مضت, ياسر خليل أبو البراء said:

أخي الكريم اسخدم كلمة ClearContents بدلاً من ClearFormats

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

لا يجب استعمال ClearContents في هذه الحالة

قام بنشر

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

تقبل تحياتي أخي الحبيب سليم

 

  • Like 1
قام بنشر (معدل)
8 دقائق مضت, ياسر خليل أبو البراء said:

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

تقبل تحياتي أخي الحبيب سليم

 

 

8 دقائق مضت, ياسر خليل أبو البراء said:

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

تقبل تحياتي أخي الحبيب سليم

 

ربما يجب استبدال الكود بهذا (من الضروري تجربة الكود على ملف وهمي  او نسخة احتياطية قبل ذلك)

Sub talween1()
  For x = 1 To Sheets.Count
        With Sheets(x)
                ro = .Cells(Rows.Count, "O").End(3).Row

                   For Each cell In .Range("o1:O" & ro)
                        If IsNumeric(cell) And cell.Value < 0 Then
                          cell.Offset(0, -14).Resize(1, 15).Interior.ColorIndex = 3
                          Else
                          cell.Offset(0, -14).Resize(1, 15).Interior.ColorIndex = vbBlack
                        End If
                  
                   Next
        End With
   Next
End Sub

 

تم تعديل بواسطه سليم حاصبيا
  • Like 2
قام بنشر

هههههههههههههههه اشتغل وربنا محدش يتريق عليا والله انا مش مصدق انى خلصت الشغل ف اقل من دقيقه شغل كان ممكن يقعد معايه اسبوعين مهما اقول من كلام مش هعرف اشكركم على الى عملتوه معايا وربنا انتم ناس محترمه جدااااااااااااااااااا ربنا يجعلو فى ميزان حسناتكم :D

  • Like 1
قام بنشر

أخي الكريم محمد

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

 

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

تقبل تحياتي

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information