أكاديمية الصقر للتدريب

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


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





توزيع مشروط

هل من طريقة لعمل كود توزيع بناءً على شروط معينة كما في دالة COUNTIF بحيث يتم عملية العد بواسطتها ثم توزيع حسب المعطيات ..


موضوع مغلق


subject icon تمت الإجابة توزيع مشروط
10-11-2021 03:35 مساء
علي بطيخ سالم
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 19-09-2018
رقم العضوية : 8086
المشاركات : 277
الجنس : ذكر
تاريخ الميلاد : 30-10-1982
الدعوات : 1
يتابعهم : 7
يتابعونه : 3
قوة السمعة : 1084
عدد الإجابات: 12
 offline 

هل من طريقة لعمل كود توزيع بناءً على شروط معينة كما في دالة COUNTIF بحيث يتم عملية العد بواسطتها ثم توزيع حسب المعطيات
 
 
 
  توزيع عادل.xlsm   تحميل xlsm مرات التحميل :(14)
الحجم :(381.696) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
إليك الكود التالي عله يفي بالغرض إن شاء الله
Sub Test()
    Dim v, rng As Range, c As Range, r As Long, i As Integer
    Application.ScreenUpdating = False
        Set rng = wsData.Range("K2:K" & wsData.Cells(Rows.Count, "K").End(xlUp).Row)
        rng.Offset(, 8).ClearContents
        r = 2
        For Each c In wsSearch.Range("AC3:AC" & wsSearch.Cells(Rows.Count, "AC").End(xlUp).Row).Cells
            c.Offset(, 1).Value = Application.WorksheetFunction.CountIf(rng, c.Value)
            v = Distribute(Val(c.Offset(, 1).Value), Val(c.Offset(, 2)))
            For i = LBound(v) To UBound(v)
                wsData.Cells(r, "S").Resize(v(i)).Value = i
                r = r + Val(v(i))
            Next i
        Next c
    Application.ScreenUpdating = True
    MsgBox "Done...", 64, "YasserKhalil Excel-Egy"
End Sub

Function Distribute(ByVal total As Long, ByVal num As Long)
    Dim i As Long
    ReDim amounts(1 To num) As Long
    For i = 1 To num
        amounts(i) = Application.RoundUp(total / num, 0)
        total = total - amounts(i): num = num - 1
    Next i
    Distribute = amounts
End Function

 
عرض الإجابة




10-11-2021 07:04 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif توزيع مشروط
السلام عليكم بها نبدأ أخي العزيز علي (يبدو أن ضغط الشغل أنساك) ... smile

بدايةً من هذه اللحظة سأكف عن الإعلان عن المتغيرات الخاصة بورقة العمل لأنها تستهلك أسطر من الكود بدون داعي
أقصد بدلاً من الأسطر التالية للإعلان عن أوراق العمل التي سنتعامل معها ، يمكن تغيير الاسم البرمجي لورقة العمل واستخدامه مباشرةً دون الحاجة لأسطر الكود
Sub MyTest()
    Dim wsData As Worksheet, wsSearch As Worksheet
    Set wsData = ThisWorkbook.Worksheets("Data")
    Set wsSearch = ThisWorkbook.Worksheets("Search")
End Sub


سيتم الاستغناء عن مثل هذه الأسطر وستذهب لمحرر الأكواد ومن نافذة المشروع تختار ورقة العمل ، ثم تذهب لنافذة Properties أسفل منها ، وفي خاصية Name تكتب الاسم البرمجي لورقة العمل ويفضل أن يكون ببادئة مثل ws يليها اسم ورقة العمل باللغة الإنجليزية ، وفي مثالنا ورقتي العمل سيكون الاسم البرمجي لهما wsData و wsSearch

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

10-11-2021 07:12 مساء
مشاهدة مشاركة منفردة [2]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif توزيع مشروط
إليك الكود التالي عله يفي بالغرض إن شاء الله
Sub Test()
    Dim v, rng As Range, c As Range, r As Long, i As Integer
    Application.ScreenUpdating = False
        Set rng = wsData.Range("K2:K" & wsData.Cells(Rows.Count, "K").End(xlUp).Row)
        rng.Offset(, 8).ClearContents
        r = 2
        For Each c In wsSearch.Range("AC3:AC" & wsSearch.Cells(Rows.Count, "AC").End(xlUp).Row).Cells
            c.Offset(, 1).Value = Application.WorksheetFunction.CountIf(rng, c.Value)
            v = Distribute(Val(c.Offset(, 1).Value), Val(c.Offset(, 2)))
            For i = LBound(v) To UBound(v)
                wsData.Cells(r, "S").Resize(v(i)).Value = i
                r = r + Val(v(i))
            Next i
        Next c
    Application.ScreenUpdating = True
    MsgBox "Done...", 64, "YasserKhalil Excel-Egy"
End Sub

Function Distribute(ByVal total As Long, ByVal num As Long)
    Dim i As Long
    ReDim amounts(1 To num) As Long
    For i = 1 To num
        amounts(i) = Application.RoundUp(total / num, 0)
        total = total - amounts(i): num = num - 1
    Next i
    Distribute = amounts
End Function

 

10-11-2021 07:18 مساء
مشاهدة مشاركة منفردة [3]
علي بطيخ سالم
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 19-09-2018
رقم العضوية : 8086
المشاركات : 277
الجنس : ذكر
تاريخ الميلاد : 30-10-1982
الدعوات : 1
يتابعهم : 7
يتابعونه : 3
قوة السمعة : 1084
عدد الإجابات: 12
 offline 
look/images/icons/i1.gif توزيع مشروط
السلام عليكم ورحمة الله وبركاته:
blushing بالفعل نسيت (وما أنسانيه إلا الشيطان أن أذكره) نعوذ بالله من الشيطان الرجيم.

ياليت تشرح لنا واحدة واحدة علشان أنا راح ابدأ بإذن الله في سلسلة لا تعطني سمكة ومن الأفضل أن يكون الشغل عملي وليس نظري ونحن تعودنا منك ذلك يعني كثير من أساتذتنا الكرام يمدوننا بالحل المباشر دون توضيح (والحق يقال: أن لكل واحد منا ما يشغله خاصة في هذا الزمن الذي نصفه بزمن السرعة) نسأل الله أن يعين الجميع... أنا ما أقصده من هنا إن شاء الله تكون الانطلاقة والبداية جزاكم الله خيراً وبارك الله لك استاذنا وأنا بدأت في تنفيذ الخطوات التي أشرت إليها استاذنا.



10-11-2021 07:24 مساء
مشاهدة مشاركة منفردة [4]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif توزيع مشروط
بارك الله فيك أخي العزيز علي
الكود بسيط لذا سأترك الشرح لكم .. ادرس الكود سطر بسطر وإذا تعذر عليك فهم سطر ما ضع مشاركة وسأحاول شرحه لك إن شاء الله

10-11-2021 07:27 مساء
مشاهدة مشاركة منفردة [5]
علي بطيخ سالم
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 19-09-2018
رقم العضوية : 8086
المشاركات : 277
الجنس : ذكر
تاريخ الميلاد : 30-10-1982
الدعوات : 1
يتابعهم : 7
يتابعونه : 3
قوة السمعة : 1084
عدد الإجابات: 12
 offline 
look/images/icons/i1.gif توزيع مشروط
أحسنت وأبدعت أستاذنا (جزاكم الله خيراً وبارك الله استاذنا) وسوف احاول جاهداً دراسة هذا الكود ودراسة جميع الأكواد الأخرى بجدية وطريقة عملها ولعلك تسمح لي واساتذتي الكرام جميع بطرح بعض الأسئلة حول بعض النقاط التي نتوقف عندها في هذه الدراسة. 

10-11-2021 07:43 مساء
مشاهدة مشاركة منفردة [6]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif توزيع مشروط
لا مشكلة على الإطلاق أخي العزيز علي
اسأل ما شئت وسأجيبك حسب ما توفر لي من وقت ومن علم



الكلمات الدلالية
توزيع ، مشروط ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 06:58 مساء