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

[فوزى فوزى]

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

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

تم تعديل أغسطس 13 بواسطه فوزى فوزى

[محمد هشام.]

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

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

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

تم تعديل أغسطس 14 بواسطه محمد هشام.

[فوزى فوزى]

بسم الله ما شاء الله تمام تسلم ايديك استاذ محمد الله يرضى عنك