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

كود الملف ثقيل


إذهب إلى أفضل إجابة Solved by حسونة حسين,

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

السلام عليكم 
من فضلكم عندي شيت 1 و 2 وضعت كود لنسخ محتوى محدد (E13:AI72,E101:AI176) من شيت إسمه 
ENTP. El  AMINE G
 إلى الثاني إسمه ENTP-SH
 بواسطة كود vba,  لكن الود ثقيل جدا , فهل فيه إمكانية أن الكود يكون أسرع أو يعمل عند النقر على الشيت الثاني
Si select ENTP-SH

 الكود الذي في الشيت الأول أظن أنه طويل جدا فلربما يكون هو سبب بطىء الكود

 

ملف جديد.xlsm

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

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

جرب هذا التعديل اخى الكريم

Sub Copie_sh()
    Application.EnableEvents = False
    Sheets("ENTP-SH").Range("E13:AI72").Value = Sheets("ENTP.EL AMINE G").Range("E13:AI72").Value
    Sheets("ENTP-SH").Range("E101:AI164").Value = Sheets("ENTP.EL AMINE G").Range("E101:AI164").Value
    Application.EnableEvents = True
End Sub

 

  • Like 1
رابط هذا التعليق
شارك

تفضل اخي   عربي مسلم

ضع  كودك بين هذاين السترين

 

'Application.Calculation = xlCalculationManual

 

 

'Application.Calculation = xlCalculationAutomatic

 

ان شاء الله يكون هو المطلوب

الملف جاهز  ملف جديد.xlsm

 

  • Like 1
رابط هذا التعليق
شارك

الكود الذي هو سيي البطىء أظنه هذا , فالرجاء ممن لديه حبرة في الأكواد التعديل عليه

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ws As Worksheet
تحديث كود النسخ  Call Copie_sh
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
كود إظهار و إخفاء الصفوف 
 Set ws = Sheets("ENTP-SH")
     If Target.Address = Range("B161").Address Then
                 If Target.Value = "" Then
        ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows(161).EntireRow.Hidden = True
                     Else
              ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows("161").EntireRow.Hidden = False
              ws.Protect Password:="1 1"
        End If
         ws.Protect Password:="1 1"
      End If
           If Target.Address = Range("B162").Address Then
        If Target.Value = "" Then
        ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows(162).EntireRow.Hidden = True
           Else
              ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows("162").EntireRow.Hidden = False
               ws.Protect Password:="1 1"
        End If
        ws.Protect Password:="1 1"
      End If
           If Target.Address = Range("B163").Address Then
        If Target.Value = "" Then
         ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows(163).EntireRow.Hidden = True
           Else
              ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows("163").EntireRow.Hidden = False
             ws.Protect Password:="1 1"
        End If
           ws.Protect Password:="1 1"
      End If
     If Target.Address = Range("B164").Address Then
        If Target.Value = "" Then
           ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows(164).EntireRow.Hidden = True
           Else
              ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows("164").EntireRow.Hidden = False
              ws.Protect Password:="1 1"
        End If
           ws.Protect Password:="1 1"
    End If

كود حساب "P"
    If Not Intersect(Target, Range("E13:ai72:E101:AI164")) Is Nothing Then
       Range("E165:AI165").Formula = "=IF(COUNTIF(E$13:E$72:E$101:E$164,""P"")=0,"" "",COUNTIF(E$13:E$72:E$101:E$164,""P""))"
       Range("E165:AI165").Value = Range("E165:AI165").Value
       Range("E167:N167").Formula = "=IF(COUNTIF($E$165:$AH$165,E166)=0,"""",COUNTIF($E$165:$AH$165,E166))"
       Range("E166").Formula = "=IFERROR(LARGE($E$165:$AI$165,1),"""")"
       Range("F166:N166").Formula = "=IFERROR(LARGE($E$165:$AH$165,SUM($E$167:E167,1)),"""")"
       Range("E167:N167").Value = Range("E167:N167").Value
       Range("E166:N166").Value = Range("E166:N166").Value
    End If
      Application.DisplayAlerts = True
      Application.ScreenUpdating = TrueEnd
      Application.Calculation = xlCalculationAutomatic
End Sub

 

رابط هذا التعليق
شارك

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

 Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ws As Worksheet
تحديث كود النسخ  Call Copie_sh
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
كود إظهار و إخفاء الصفوف 
 Set ws = sheets("ENTP-SH")
     If Target.Address = Range("B161").Address Then
                 If Target.Value = "" Then
        ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows(161).EntireRow.Hidden = True
                     Else
              ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows("161").EntireRow.Hidden = False
              ws.Protect Password:="1 1"
        End If
         ws.Protect Password:="1 1"
      End If
           If Target.Address = Range("B162").Address Then
        If Target.Value = "" Then
        ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows(162).EntireRow.Hidden = True
           Else
              ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows("162").EntireRow.Hidden = False
               ws.Protect Password:="1 1"
        End If
        ws.Protect Password:="1 1"
      End If
           If Target.Address = Range("B163").Address Then
        If Target.Value = "" Then
         ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows(163).EntireRow.Hidden = True
           Else
              ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows("163").EntireRow.Hidden = False
             ws.Protect Password:="1 1"
        End If
           ws.Protect Password:="1 1"
      End If
     If Target.Address = Range("B164").Address Then
        If Target.Value = "" Then
           ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows(164).EntireRow.Hidden = True
           Else
              ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows("164").EntireRow.Hidden = False
              ws.Protect Password:="1 1"
        End If
           ws.Protect Password:="1 1"
    End If
كود حساب "P"
    If Not Intersect(Target, Range("E13:ai72:E101:AI164")) Is Nothing Then
       Range("E165:AI165").Formula = "=IF(COUNTIF(E$13:E$72:E$101:E$164,""P"")=0,"" "",COUNTIF(E$13:E$72:E$101:E$164,""P""))"
       Range("E165:AI165").Value = Range("E165:AI165").Value
       Range("E167:N167").Formula = "=IF(COUNTIF($E$165:$AH$165,E166)=0,"""",COUNTIF($E$165:$AH$165,E166))"
       Range("E166").Formula = "=IFERROR(LARGE($E$165:$AI$165,1),"""")"
       Range("F166:N166").Formula = "=IFERROR(LARGE($E$165:$AH$165,SUM($E$167:E167,1)),"""")"
       Range("E167:N167").Value = Range("E167:N167").Value
       Range("E166:N166").Value = Range("E166:N166").Value
    End If
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic
End Sub

 

 

رابط هذا التعليق
شارك

اخي  عربي مسلم

اخي  اعتقد ان الكود يعمل بكفائه بعد التعديل عليه

تفضل ملف جديد.xlsm

الكود بعد التعديل

Private Sub Worksheet_Change(ByVal Target As Range)
  
   Application.Calculation = xlCalculationManual

  
  Dim ws As Worksheet
  Call Copie_sh
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Set ws = Sheets("ENTP-SH")
     If Target.Address = Range("B161").Address Then
                 If Target.Value = "" Then
        ws.Unprotect Password:="1 1"
           Sheets("ENTP-SH").Rows(161).EntireRow.Hidden = True
                     Else
           Sheets("ENTP-SH").Rows("161").EntireRow.Hidden = False
        End If
      End If
           If Target.Address = Range("B162").Address Then
        If Target.Value = "" Then
           Sheets("ENTP-SH").Rows(162).EntireRow.Hidden = True
           Else
           Sheets("ENTP-SH").Rows("162").EntireRow.Hidden = False
        End If
      End If
           If Target.Address = Range("B163").Address Then
        If Target.Value = "" Then
           Sheets("ENTP-SH").Rows(163).EntireRow.Hidden = True
           Else
           Sheets("ENTP-SH").Rows("163").EntireRow.Hidden = False
        End If
      End If
     If Target.Address = Range("B164").Address Then
        If Target.Value = "" Then
           Sheets("ENTP-SH").Rows(164).EntireRow.Hidden = True
           Else
           Sheets("ENTP-SH").Rows("164").EntireRow.Hidden = False
        End If
           ws.Protect Password:="1 1"
         End If
    If Not Intersect(Target, Range("E13:ai72:E101:AI164")) Is Nothing Then
       Range("E165:AI165").Formula = "=IF(COUNTIF(E$13:E$72:E$101:E$164,""P"")=0,"" "",COUNTIF(E$13:E$72:E$101:E$164,""P""))"
       Range("E165:AI165").Value = Range("E165:AI165").Value
       Range("E167:N167").Formula = "=IF(COUNTIF($E$165:$AH$165,E166)=0,"""",COUNTIF($E$165:$AH$165,E166))"
       Range("E166").Formula = "=IFERROR(LARGE($E$165:$AI$165,1),"""")"
       Range("F166:N166").Formula = "=IFERROR(LARGE($E$165:$AH$165,SUM($E$167:E167,1)),"""")"
       Range("E167:N167").Value = Range("E167:N167").Value
       Range("E166:N166").Value = Range("E166:N166").Value
    End If
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic
End Sub

 

رابط هذا التعليق
شارك

شكر الله سعيك و بارك في عمرك, الكود أصبح أفضل مما كان عليه و مختصر ما شاء الله, عدا أشياء لم أفهمها مثل الإخفاء و الإظهار و كذلك عند تحديد أكثر من خلية يعطيني حطأ, ممكن بسبب الحماية لم أعرف كيف اضعها في الكود.

و الحقيقة الكود رائع.

و الفضل لك أخي الغالي hassona229

و إن شاء الله تفيدنا عن سبب عدم عمل الكود عند تحديد عدة خلايا و كذلك كيف يعمل كود الإظهار و الإخفاء

شكرا شكرا ثم شكرا

 

رابط هذا التعليق
شارك

 أخي الغالي hassona229

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

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

شكرا جزيلا

OFFICENA1.png

OFFICENA2.png

رابط هذا التعليق
شارك

hassona229

 

بارك الله فيك، هل رأيت الصور التي أرسلتها أخي الغالي و الملاحظات الأخرى. 

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

كذلك عند تحديد أكثر من خلية و كتابة P أو رمز آخر حسب القائمة المنسدلة لكل خلية يظهر أن هناك خطأ في الكود لم أهتدي أنا لحله. 

بارك الله فيك اخي العزيز و جزاك الله خيراً. 🖊🌹💐

رابط هذا التعليق
شارك

hassona229

 

بارك الله فيك، هل رأيت الصور التي أرسلتها أخي الغالي و الملاحظات الأخرى. 

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

كذلك عند تحديد أكثر من خلية و كتابة P أو رمز آخر حسب القائمة المنسدلة لكل خلية يظهر أن هناك خطأ في الكود لم أهتدي أنا لحله. 

بارك الله فيك اخي العزيز و جزاك الله خيراً. 🖊🌹💐

رابط هذا التعليق
شارك

السلام عليكم أخي المبارك الفاضل الغالي على جهدك الذي يذكر فيشكر, عمل رائع بأتم معنى الكلمة, فالملف أصبح يسير و يعمل 10/10, و هذا كله بفضل معونتك و مساعدتك أخي حسونة حسين أبو عائشة رقية و محمد hassona229

فقط كود الطباعة لم أفهمه فماذا يعني , وفقك ربي لما يحب و يرضى

QR YACINE.jpg

رابط هذا التعليق
شارك

أخي حسونة حسين أبو عائشة رقية و محمد hassona229

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

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

تم تعديل بواسطه عربي مسلم
رابط هذا التعليق
شارك

أخي الحبيب حسونةhassona229 

الملف رائع جدا لكن كلما أضع له الحماية(حماية المعادلات) تنفك بعدها 

ربما لم أستطع توضيح المشكل بشكل جيد فاظطررت لإرسال هذا الرابط من قناتي (

)

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information