اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

وضع نصوص مكررة في عمود حسب عدد معين


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

بسم الله الرحمن الرحيم

الأخوة الكرام في الملف المرفق لإحصائية شهرية لصفوف المدرسة

مطلوب وضع أسماء الصفوف الموجودة في النطاق ( F4: N4 ) الملون باللون الأخضر في النطاق ( B15:B114) الملون بالون الأصفر حسب العدد الموجود تحت الصف في النطاق ( F5: N5 ) والذي يمثل الشعب في كل صف

فمثلا :

الصف ( الأول ) العدد الذي تحته يساوي ( 2 ) إذا مطلوب وضع كلمة ( الأول ) في النطاق ( B15:B114) مرتين

وهكذا كل صف حسب الرقم الذي تحته والذي يمثل عدد الشعب في كل صف

إحصائية شهرية.rar

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

حياك الله يا بو أحمد دائما لنا بالمرصاد جزاك الله خير

رددت على الموضوع من غير ما أنظر للحل لأني متأكد من خبرتكم وقدرتكم الفائقة على ذلك

طيب للفائدة هل ممكن عمل ذلك من خلال دوال معينة بدون كود

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

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

  • 4 weeks later...

السلام عليكم

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


Sub Abu_Ahmed()

Range("b15:b114").ClearContents

For i = 6 To 14

For x = 1 To Cells(5, i).Value

	  Cells(Range("b10000").End(xlUp).Row + 1, 2) = Cells(4, i)

Next x

Next i

End Sub

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

تفضل الملف المرفق

تم الحل على خطوتين

الأولى : تعتبر بادئة الحركة وتعمل على التاكد من وجود ارقام في الخلايا F5:N5 وتم إدخال هذه المعادلة في الخلية B15

الثانية : تقوم بإدراج القيم وفقاً لمرات تكرارها

ملاحظة : هناك بعض العيوب في هذه المعادلات

  • في حالة ان عدد الشعب في أحد الصفوف = 0 فإن جدول البيانات سيدرج خانة واحدة بها هذا الفصل.
  • لم استخدم الدالة IFERROR لإخفاء الأخطاء عندما يتم إدراج جميع الصفوف بالكامل (بمعنى اننا اذا انتهينا من الصف التاسع ) وذلك لأنك ادرجت ملف بصيغة XLS وهي اي الدالة غير مدعومة بهذه الإصدارة 2003؛ لذلك ان كنت تستخدم نسخة 2007 أو ما يليها يمكنك استخدام الدالة لإخفاء هذه الأخطاء

بالتوفيق بإذن الله

إحصائية شهرية.rar

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

السلام عليكم

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

عبد الله المجرب والحسامي مساعدتي فيه....

وشكرا سلفا

إحصائية شهري3ة.rar

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

السلام عليكم ....

أولا اشكر الجميع على هذا الموضوع لكن لاحظت مشكل بسيط لو تكرمتم بحله...

مع العلم أنني احاول بدوري لايجاد حل له...

- المشكل هو :

- في حالة ترك خانة فارغة " مثلا : الصف الثالث غير موجود " , يحدث خلل في التوزيع ولا تكمل العملية

لذا نطلب منكم اخوتي الحل : يعني لو نترك صف فارغ أو "0" يتم توزيع الذي قبله والذي بعده

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

السلام عليكم

الاخ الفاضل addora2006

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

بيكون الكود هكذا


Sub Abu_Ahmed()

Range("d18:d114").ClearContents

For I = 5 To 12

For x = 1 To Cells(10, I).Value

		  Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, I)

Next x

Next I

End Sub

==========================================================

- في حالة ترك خانة فارغة " مثلا : الصف الثالث غير موجود " , يحدث خلل في التوزيع ولا تكمل العملية "إقتباس"

==========================================

الكود لايحسب الخلايا الفارغه ويستخدم التي بعدها بمعنى لايحدث خلل

ربما اكون فهمت قصدك خطاء

هل تعني احد عدد (السنه الاولى ثانوي) تركته فارغ وسبب اختلال في التوزيع

اذا كان هذا معنى كلامك

فأطمن جربت الكود ووزع تمام على ملفك

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

السلام عليكم

أخ علي شكرا على التجاوب منك ... وشكرا لهذا المنتدي الرائع الذي منه نتعلم كثيرا

ولكن عندي مشكل بهذا الكود لو تطلع عليه :


Sub Ab1_Ahmed()


If Range("F5") = 1 Then

Range("d18:d114,f18:f114,h18:h114").ClearContents

For I = 5 To 6

For x = 1 To Cells(10, I).Value

				  Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, I)

For m = 5 To 12

For k = 1 To Cells(11, I).Value

				  Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, I)

For n = 5 To 12

For l = 1 To Cells(12, I).Value

				  Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, I)


Next x

Next I

Next k

Next m

Next l

Next n

  Else


Range("d18:d114").ClearContents

For I = 5 To 8

For x = 1 To Cells(10, I).Value

				  Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, I)


Next x

Next I

   End If

End Sub

- اخي الكريم المطلوب موجود بالمرفق وفي الورقة رقم 02

وشكرا سلفا وانا بدوري احاول ان اجد الحل

من إحصائية شهرية.rar

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

السلام عليكم

جرب هكذا


Sub Abu_Ahmed()

Range("d18:h114").ClearContents

If Range("a3").Value = 2 Then

For I = 5 To 12

For x = 1 To Cells(10, I).Value

Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, I)

Next

Next

Else

For i1 = 5 To 12

For x1 = 1 To Cells(11, i1).Value

Cells(Range("f10000").End(xlUp).Row + 1, 6) = Cells(9, i1)

Next

Next

For i2 = 5 To 12

For x2 = 1 To Cells(12, i2).Value

Cells(Range("h10000").End(xlUp).Row + 1, 8) = Cells(9, i2)

Next

Next

For i3 = 5 To 12

For x3 = 1 To Cells(10, i3).Value

Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, i3)

Next

Next

Exit Sub

End If

End Sub

وهذا ملفك وعليه الكود اعلاه

من إحصائية شهرية_ali.rar

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

السلام عليكم اخي علي ...

اشكرك للمساعدة وسرعة الرد وكما وعدتك فانني بقيت احاول واجرب

الى ان وصلت لحل على طريقتي .... ولكن طريقتك طبعا احسن وايسر ... بدون مجاملة

فانني اتشرف بان تنظر لطريقتي وتعطيني رايك فيها

بقيت لديا مشكلة واحدة وهي بسيطة :

عندما تكون الخلية A3 =2 أريد ان يتم مسح محتوي الخلايا : G10,L10

أما إذا كانتA3 =1 أريد ان يتم مسح محتوي الخلايا : E11;L12 - I10;L10

وعلي كل حال فاني اشكرك من صميم قلبي ... واتمني منك ان تطلع على محاولتي وتوجيهي

addoraمن إحصائية شهرية.rar

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

السلام عليكم

حلك جميل برضه ونفس الطريقة ولاكن بعدت مودويل

وبالنسبة لطلبك الاخير سهل اخي

في اول الشرط


If Range("a3").Value = 2 Then

تحط ماطلبته في مشاركتك في جواب الشرط هذا السطر

Range("d18:d114").ClearContents

لمسح بيانات عمود الـــ D فقط وفي عدم توافق الشرط بعد الكلمة التاليه

Else

تحد هذا المدى وهو من D حتى H

Range("d18:h114").ClearContents

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

Sub Abu_Ahmed()

If Range("a3").Value = 2 Then

Range("d18:d114").ClearContents

For I = 5 To 12

For x = 1 To Cells(10, I).Value

Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, I)

Next

Next

Else

Range("d18:h114").ClearContents

For i1 = 5 To 12

For x1 = 1 To Cells(11, i1).Value

Cells(Range("f10000").End(xlUp).Row + 1, 6) = Cells(9, i1)

Next

Next

For i2 = 5 To 12

For x2 = 1 To Cells(12, i2).Value

Cells(Range("h10000").End(xlUp).Row + 1, 8) = Cells(9, i2)

Next

Next

For i3 = 5 To 12

For x3 = 1 To Cells(10, i3).Value

Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, i3)

Next

Next

Exit Sub

End If

ارجو ان تكون وضحت الصورة لديك

تحياتي

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information