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

توزيع الاسهم بناء على شرط الموجود فى الخلية H1


إذهب إلى أفضل إجابة Solved by محمد هشام.,

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

السلام عليكم ورحمة الله وبركاته اساتذتى الكرام اتوجه بالشكر لااستاذ المحترم الاستاذ محمد هشام على تعبه معى حتى اتم الملف على اكمل وجه تبقى لى نقطة واحدة فى هذا الملف ارجو تكملة على الكود الموجود بداخل الملف وهو توزيع الملغ حسب خلية سهم الفرد وهى الخلية H1 حيث مكتوب فيها 100 جنيه هنعطى مثال على اسم صلاح فى شهر 2 توزيع  مبلغ 150 عند ترحيل المبلغ ينظر على الاسماء الموجود فى العمود B11:B7 هيكون اسم صلاح مكرر مرتين مرة اسم صلاح لوحدة ومرة اسم صلاح مشترك مع اسم هانى هيوزع 150 الموجوده فى الخليه B3 على النحو التالى هينظر فى خلية سهم الفرد وهى  H1 موجود فيها 100 جنيه بناء على هذه الخلية هيوزع المبلغ هيرحل 100 جنية لاسم صلاح والباقى وهو 50 جنية هيرحله لاسم صلاح المشترك مع اسم هانى وهذا مثال على المطلوب

توزيع الاسهم.xlsm

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

  • فوزى فوزى changed the title to توزيع الاسهم بناء على شرط الموجود فى الخلية H1
  • أفضل إجابة

وعليكم السلام ورحمة الله تعالى وبركاته 

إذا كنت قد إستوعبت طلبك بشكل صحيح  هذا سيوفي بالغرض 

Sub Trhel()
Dim tmp As Range, C As Range
Dim rng As Range: Set rng = [B1:B3]
Check = Len([B1])
Share = [H1].Value
If WorksheetFunction.CountA(rng) < 3 Or Share = 0 Then Exit Sub
                                    
Set tmp = [C6:N6].Find([B2]) 'Or <<========'Set tmp = Rows(6).Find([B2])
For Each j In Range("b7:b" & Cells(Rows.Count, "b").End(xlUp).Row)
    A = j.Row: B = tmp.Column: Set C = Cells(A, B)
    
    If j.Value Like [B1].Value Then _
       C.Value = C.Value + Share Else
    If j.Value Like "*" & [B1].Value & "*" And _
Len(j.Value) > Check Then C.Value = C.Value + Share / 2
    
    Next j
End Sub

 

توزيع الاسهم V2.xlsm

تم تعديل بواسطه محمد هشام.
  • Like 2
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information