عربي مسلم قام بنشر يناير 3, 2022 مشاركة قام بنشر يناير 3, 2022 (معدل) السلام عليكم من فضلكم عندي شيت 1 و 2 وضعت كود لنسخ محتوى محدد (E13:AI72,E101:AI176) من شيت إسمه ENTP. El AMINE G إلى الثاني إسمه ENTP-SH بواسطة كود vba, لكن الود ثقيل جدا , فهل فيه إمكانية أن الكود يكون أسرع أو يعمل عند النقر على الشيت الثاني Si select ENTP-SH الكود الذي في الشيت الأول أظن أنه طويل جدا فلربما يكون هو سبب بطىء الكود ملف جديد.xlsm تم تعديل يناير 4, 2022 بواسطه عربي مسلم 1 رابط هذا التعليق شارك More sharing options...
حسونة حسين قام بنشر يناير 3, 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 1 رابط هذا التعليق شارك More sharing options...
محمد يوسف ابو يوسف قام بنشر يناير 4, 2022 مشاركة قام بنشر يناير 4, 2022 تفضل اخي عربي مسلم ضع كودك بين هذاين السترين 'Application.Calculation = xlCalculationManual 'Application.Calculation = xlCalculationAutomatic ان شاء الله يكون هو المطلوب الملف جاهز ملف جديد.xlsm 1 رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 4, 2022 الكاتب مشاركة قام بنشر يناير 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 رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 4, 2022 الكاتب مشاركة قام بنشر يناير 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 رابط هذا التعليق شارك More sharing options...
حسونة حسين قام بنشر يناير 4, 2022 مشاركة قام بنشر يناير 4, 2022 لم ترد على سؤالى لانى مسحت البيانات وجربت الكود بعد التعديل الذي وضعته لك والكود ياتى بالبيانات في الشيت المطلوب ENTP-SH 1 رابط هذا التعليق شارك More sharing options...
حسونة حسين قام بنشر يناير 4, 2022 مشاركة قام بنشر يناير 4, 2022 لم ترد على سؤالى لانى مسحت البيانات وجربت الكود بعد التعديل الذي وضعته لك والكود ياتى بالبيانات في الشيت المطلوب ENTP-SH 1 رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 4, 2022 الكاتب مشاركة قام بنشر يناير 4, 2022 السلام عليكم , أخي الكريم حسونة كود النسح يعمل , لكن فيه كود آخر في الشيت الأول صار لا يعملhassona229 رابط هذا التعليق شارك More sharing options...
محمد يوسف ابو يوسف قام بنشر يناير 5, 2022 مشاركة قام بنشر يناير 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 رابط هذا التعليق شارك More sharing options...
أفضل إجابة حسونة حسين قام بنشر يناير 8, 2022 أفضل إجابة مشاركة قام بنشر يناير 8, 2022 تفضل اخى عربي ملف جديد.xlsm 2 رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 8, 2022 الكاتب مشاركة قام بنشر يناير 8, 2022 شكر الله سعيك و بارك في عمرك, الكود أصبح أفضل مما كان عليه و مختصر ما شاء الله, عدا أشياء لم أفهمها مثل الإخفاء و الإظهار و كذلك عند تحديد أكثر من خلية يعطيني حطأ, ممكن بسبب الحماية لم أعرف كيف اضعها في الكود. و الحقيقة الكود رائع. و الفضل لك أخي الغالي hassona229 و إن شاء الله تفيدنا عن سبب عدم عمل الكود عند تحديد عدة خلايا و كذلك كيف يعمل كود الإظهار و الإخفاء شكرا شكرا ثم شكرا رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 8, 2022 الكاتب مشاركة قام بنشر يناير 8, 2022 أخي الغالي hassona229 أكواد إضافة السطور هل أستعملها أم الكود الجديد يكفي,علما أني لم تنجح معي في خال إضافة السطر في الشيت الأول ينظاف في الشيت الثاني, كذلك لا أستطيع إضافته يدويا بدون كود لأن الحماية على الشيت يجب أن تبقى سارية المفعول دائما لمن يرسل لهم الملف للعمل عليه. لم أستطع إرسال الملف و نزعت بعض الصور في أعلى الملف تبين الفرق بين الشيتين لمشكلة أن الموقع محدد حجم الملف. شكرا جزيلا رابط هذا التعليق شارك More sharing options...
حسونة حسين قام بنشر يناير 8, 2022 مشاركة قام بنشر يناير 8, 2022 اخى الكود الجديد به كل ما تحتاج ان شاء الله 1 رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 8, 2022 الكاتب مشاركة قام بنشر يناير 8, 2022 hassona229 بارك الله فيك، هل رأيت الصور التي أرسلتها أخي الغالي و الملاحظات الأخرى. الملف لما يكون محمي لا يمكن إضافة أي سطر جديد، فكيف أضيف أسطر من 161 إلى 164 هل فيه طريقة أخرى، لم أعرف و لم تنجح معي حتى مع إزالة الحماية للتجربة. كذلك عند تحديد أكثر من خلية و كتابة P أو رمز آخر حسب القائمة المنسدلة لكل خلية يظهر أن هناك خطأ في الكود لم أهتدي أنا لحله. بارك الله فيك اخي العزيز و جزاك الله خيراً. 🖊🌹💐 رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 9, 2022 الكاتب مشاركة قام بنشر يناير 9, 2022 hassona229 بارك الله فيك، هل رأيت الصور التي أرسلتها أخي الغالي و الملاحظات الأخرى. الملف لما يكون محمي لا يمكن إضافة أي سطر جديد، فكيف أضيف أسطر من 161 إلى 164 هل فيه طريقة أخرى، لم أعرف و لم تنجح معي حتى مع إزالة الحماية للتجربة. كذلك عند تحديد أكثر من خلية و كتابة P أو رمز آخر حسب القائمة المنسدلة لكل خلية يظهر أن هناك خطأ في الكود لم أهتدي أنا لحله. بارك الله فيك اخي العزيز و جزاك الله خيراً. 🖊🌹💐 رابط هذا التعليق شارك More sharing options...
حسونة حسين قام بنشر يناير 9, 2022 مشاركة قام بنشر يناير 9, 2022 تفضل اخى عربي ملف جديد.xlsm 1 رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 9, 2022 الكاتب مشاركة قام بنشر يناير 9, 2022 السلام عليكم أخي المبارك الفاضل الغالي على جهدك الذي يذكر فيشكر, عمل رائع بأتم معنى الكلمة, فالملف أصبح يسير و يعمل 10/10, و هذا كله بفضل معونتك و مساعدتك أخي حسونة حسين أبو عائشة رقية و محمد hassona229 فقط كود الطباعة لم أفهمه فماذا يعني , وفقك ربي لما يحب و يرضى رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 9, 2022 الكاتب مشاركة قام بنشر يناير 9, 2022 (معدل) أخي حسونة حسين أبو عائشة رقية و محمد hassona229 الملف رائع جدا لكن كلما أضع له الحماية(حماية المعادلات) تنفك بعدها مباشرة لا أدري لماذا, كذلك الحماية(حماية المعادلات) تذهب و تأتي عشوائيا عند التنقل بين الشيتين و العمل على الخلايا, تأتي تذهب و هكذا أعتذر على كثرة الرسائل و الإستشكالات , للأسف لو كان التواصل على الزوم أو غيره لما أكثرت عليك لهذه الدرجة, و كان المطلوب واضح و أسهل لك, آسف و أعتذر مرة أخرى. تم تعديل يناير 9, 2022 بواسطه عربي مسلم رابط هذا التعليق شارك More sharing options...
حسونة حسين قام بنشر يناير 9, 2022 مشاركة قام بنشر يناير 9, 2022 يمكنك اختصار كود الطباعه هكذا ActiveSheet.PrintOut Copies:=1 لطباعه الشيت المفتوح امامك ActiveSheet.PrintOut العدد المطلوب Copies:=1 1 رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 10, 2022 الكاتب مشاركة قام بنشر يناير 10, 2022 (معدل) جزاك الله خيرا أخي حسونة حسين أبو عائشة رقية و محمد hassona229 PROTECTION1.rar تم تعديل يناير 10, 2022 بواسطه عربي مسلم رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 10, 2022 الكاتب مشاركة قام بنشر يناير 10, 2022 أخي الحبيب حسونةhassona229 الملف رائع جدا لكن كلما أضع له الحماية(حماية المعادلات) تنفك بعدها ربما لم أستطع توضيح المشكل بشكل جيد فاظطررت لإرسال هذا الرابط من قناتي ( ) رابط هذا التعليق شارك More sharing options...
عربي مسلم قام بنشر يناير 11, 2022 الكاتب مشاركة قام بنشر يناير 11, 2022 شكرا جزيلا أخي الحبيب حسونةhassona229 إن شاء الله تكون اطلعت على مشكل الحماية الذي أرسلته رابط هذا التعليق شارك More sharing options...
حسونة حسين قام بنشر يناير 11, 2022 مشاركة قام بنشر يناير 11, 2022 جرب هذا التعديل اخى ياسين ملف جديد.xlsm 2 رابط هذا التعليق شارك More sharing options...
حسونة حسين قام بنشر يناير 17, 2022 مشاركة قام بنشر يناير 17, 2022 وجزاكم مثله اخى ياسين الحمد لله الذي بنعمته تتم الصالحات 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان