وجدي الحاج علي قام بنشر ديسمبر 7, 2017 مشاركة قام بنشر ديسمبر 7, 2017 سلام عليكم لدي كود مهمته احصاء المواد من مجموعة شتات وجمع المواد ووضع الناتج في صفحة مستقلة وهو يعمل مع صنف واحد لكن لا يمكنني اضافة اكتر من صنف Dim cll As Range Dim sh As Worksheet, C As Range, x As Integer x = 0 For Each sh In Sheets هنا يقوم بالبحث بجميع الشتات For Each C In sh.Range("F1:F" & sh.Cells(Rows.Count, 6).End(xlUp).Row) If C.Value = Range("g24").Value Then x = x + 1 حيث انا ring24 هو اسم المادة Next Next Range("k24") = x وهنا يضع الناتج في صفحة الجرد End Sub المطلوب ان اتمكن من اضافة عدد كبير من المواد مثال Dim cll As Range Dim sh As Worksheet, C As Range, x As Integer x = 0 For Each sh In Sheets For Each C In sh.Range("F1:F" & sh.Cells(Rows.Count, 6).End(xlUp).Row) If C.Value = Range("g24").Value Then x = x + 1 If C.Value = Range("g25").Value Then x = x + 1 If C.Value = Range("g26").Value Then x = x + 1 If C.Value = Range("g27").Value Then x = x + 1 Next Next Range("k24") = x Range("k25") = x Range("k26") = x Range("k27") = x End Sub حاولت بهذه الطريقة لكن الناتج يظهر موحد ببسب انا المتغير نفسه وهو x ارجو رد السريع واذا كان يوجد طريقة او كود اسلس من هذا او اخف عناء افادتي به رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر ديسمبر 7, 2017 مشاركة قام بنشر ديسمبر 7, 2017 27 دقائق مضت, وجدي الحاج علي said: سلام عليكم لدي كود مهمته احصاء المواد من مجموعة شتات وجمع المواد ووضع الناتج في صفحة مستقلة وهو يعمل مع صنف واحد لكن لا يمكنني اضافة اكتر من صنف Dim cll As Range Dim sh As Worksheet, C As Range, x As Integer x = 0 For Each sh In Sheets هنا يقوم بالبحث بجميع الشتات For Each C In sh.Range("F1:F" & sh.Cells(Rows.Count, 6).End(xlUp).Row) If C.Value = Range("g24").Value Then x = x + 1 حيث انا ring24 هو اسم المادة Next Next Range("k24") = x وهنا يضع الناتج في صفحة الجرد End Sub المطلوب ان اتمكن من اضافة عدد كبير من المواد مثال Dim cll As Range Dim sh As Worksheet, C As Range, x As Integer x = 0 For Each sh In Sheets For Each C In sh.Range("F1:F" & sh.Cells(Rows.Count, 6).End(xlUp).Row) If C.Value = Range("g24").Value Then x = x + 1 If C.Value = Range("g25").Value Then x = x + 1 If C.Value = Range("g26").Value Then x = x + 1 If C.Value = Range("g27").Value Then x = x + 1 Next Next Range("k24") = x Range("k25") = x Range("k26") = x Range("k27") = x End Sub حاولت بهذه الطريقة لكن الناتج يظهر موحد ببسب انا المتغير نفسه وهو x ارجو رد السريع واذا كان يوجد طريقة او كود اسلس من هذا او اخف عناء افادتي به ارفع الملف للمعالجة رابط هذا التعليق شارك More sharing options...
وجدي الحاج علي قام بنشر ديسمبر 7, 2017 الكاتب مشاركة قام بنشر ديسمبر 7, 2017 استاذ سليم يصعب عليي رفع ملف لكن توصلت الى هذا الكود Dim cll As Range Dim sh As Worksheet, C As Range, x As Integer x = 0 For Each sh In Sheets For Each C In sh.Range("F1:F" & sh.Cells(Rows.Count, 6).End(xlUp).Row) If C.Value = Range("g2").Value Then x2 = x2 + 1 If C.Value = Range("g3").Value Then x3 = x3 + 1 If C.Value = Range("g4").Value Then x4 = x4 + 1 Next Next Range("k2") = x2 Range("k3") = x3 Range("k4") = x4 End Sub وهو يعمل لكن لدي 500 سطر من الكتابة هل يمكن اختصار ذالك بكود يكرر هذه الدالات من g2 الى ل500 ولك جذيل الشكر واذا لا بد من رفع ملف اخبرني لاقوم بتصميم ملف يشبه طلبي لان الملف الذي اقوم بتعديل عليه يوجد به ملفات وحسابات لايكنني رفعها ارجو التفهم ولك جذيل الشكر استاذي سليم حاصبيا رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر ديسمبر 7, 2017 مشاركة قام بنشر ديسمبر 7, 2017 41 دقائق مضت, وجدي الحاج علي said: استاذ سليم يصعب عليي رفع ملف لكن توصلت الى هذا الكود Dim cll As Range Dim sh As Worksheet, C As Range, x As Integer x = 0 For Each sh In Sheets For Each C In sh.Range("F1:F" & sh.Cells(Rows.Count, 6).End(xlUp).Row) If C.Value = Range("g2").Value Then x2 = x2 + 1 If C.Value = Range("g3").Value Then x3 = x3 + 1 If C.Value = Range("g4").Value Then x4 = x4 + 1 Next Next Range("k2") = x2 Range("k3") = x3 Range("k4") = x4 End Sub وهو يعمل لكن لدي 500 سطر من الكتابة هل يمكن اختصار ذالك بكود يكرر هذه الدالات من g2 الى ل500 ولك جذيل الشكر واذا لا بد من رفع ملف اخبرني لاقوم بتصميم ملف يشبه طلبي لان الملف الذي اقوم بتعديل عليه يوجد به ملفات وحسابات لايكنني رفعها ارجو التفهم ولك جذيل الشكر استاذي سليم حاصبيا يمكن ان ترفعع ملفاً نموذجاً عما تريد (حوالي 20 سطر) رابط هذا التعليق شارك More sharing options...
وجدي الحاج علي قام بنشر ديسمبر 7, 2017 الكاتب مشاركة قام بنشر ديسمبر 7, 2017 نشالله حوالي ساعة ساقوم بانشاء ملف رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.