مساعدة في كود اكسل

[وجدي الحاج علي]

سلام عليكم
لدي كود مهمته احصاء المواد من مجموعة شتات
وجمع المواد ووضع الناتج في صفحة مستقلة
وهو يعمل مع صنف واحد
لكن لا يمكنني اضافة اكتر من صنف

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

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

[سليم حاصبيا]

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

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

ارفع الملف للمعالجة

[وجدي الحاج علي]

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

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
ولك جذيل الشكر

واذا لا بد من رفع ملف اخبرني لاقوم بتصميم ملف يشبه طلبي
لان الملف الذي اقوم بتعديل عليه يوجد به ملفات وحسابات لايكنني رفعها
ارجو التفهم ولك جذيل الشكر استاذي سليم حاصبيا

[سليم حاصبيا]

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 سطر)

[وجدي الحاج علي]

نشالله حوالي ساعة ساقوم بانشاء ملف