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

عربي مسلم · يناير 3, 2022

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

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

ملف جديد.xlsm

تم تعديل يناير 4, 2022 بواسطه عربي مسلم

**حسونة حسين** · يناير 3, 2022

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

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

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

محمد يوسف ابو يوسف · يناير 4, 2022

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

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

'Application.Calculation = xlCalculationManual

'Application.Calculation = xlCalculationAutomatic

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

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

عربي مسلم · يناير 4, 2022

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

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

عربي مسلم · يناير 4, 2022

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

 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

**حسونة حسين** · يناير 4, 2022

لم ترد على سؤالى

لانى مسحت البيانات وجربت الكود بعد التعديل الذي وضعته لك والكود ياتى بالبيانات في الشيت المطلوب ENTP-SH

**حسونة حسين** · يناير 4, 2022

لم ترد على سؤالى

لانى مسحت البيانات وجربت الكود بعد التعديل الذي وضعته لك والكود ياتى بالبيانات في الشيت المطلوب ENTP-SH

عربي مسلم · يناير 4, 2022

السلام عليكم , أخي الكريم حسونة

كود النسح يعمل , لكن فيه كود آخر في الشيت الأول صار لا يعملhassona229

محمد يوسف ابو يوسف · يناير 5, 2022

اخي عربي مسلم

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

تفضل ملف جديد.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

**حسونة حسين** · يناير 8, 2022

تفضل اخى عربي

ملف جديد.xlsm

عربي مسلم · يناير 8, 2022

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

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

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

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

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

عربي مسلم · يناير 8, 2022

أخي الغالي hassona229

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

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

شكرا جزيلا

**حسونة حسين** · يناير 8, 2022

اخى الكود الجديد به كل ما تحتاج ان شاء الله

عربي مسلم · يناير 8, 2022

hassona229

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

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

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

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

عربي مسلم · يناير 9, 2022

hassona229

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

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

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

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

**حسونة حسين** · يناير 9, 2022

تفضل اخى عربي

ملف جديد.xlsm

عربي مسلم · يناير 9, 2022

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

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

عربي مسلم · يناير 9, 2022

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

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

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

تم تعديل يناير 9, 2022 بواسطه عربي مسلم

**حسونة حسين** · يناير 9, 2022

يمكنك اختصار كود الطباعه هكذا

ActiveSheet.PrintOut Copies:=1

لطباعه الشيت المفتوح امامك ActiveSheet.PrintOut

العدد المطلوب Copies:=1

عربي مسلم · يناير 10, 2022

جزاك الله خيرا أخي حسونة حسين أبو عائشة رقية و محمد hassona229

PROTECTION1.rar

تم تعديل يناير 10, 2022 بواسطه عربي مسلم

عربي مسلم · يناير 10, 2022

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

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

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

)

عربي مسلم · يناير 11, 2022

شكرا جزيلا أخي الحبيب حسونةhassona229

إن شاء الله تكون اطلعت على مشكل الحماية الذي أرسلته

**حسونة حسين** · يناير 11, 2022

جرب هذا التعديل اخى ياسين

ملف جديد.xlsm

**حسونة حسين** · يناير 17, 2022

وجزاكم مثله اخى ياسين

الحمد لله الذي بنعمته تتم الصالحات

تسجيل الدخول

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

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

عربي مسلم

حسونة حسين

محمد يوسف ابو يوسف

عربي مسلم

عربي مسلم

حسونة حسين

حسونة حسين

عربي مسلم

محمد يوسف ابو يوسف

حسونة حسين

عربي مسلم

عربي مسلم

حسونة حسين

عربي مسلم

عربي مسلم

حسونة حسين

عربي مسلم

عربي مسلم

حسونة حسين

عربي مسلم

عربي مسلم

عربي مسلم

حسونة حسين

حسونة حسين

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information