استبدال دالة sumif بال VBA ارجو المساعدة

[mselmy]

اخوانى الاعزاء السلام عليكم

انا لا اجيد كتابة الاكواد البرمجية ولكن ولله الحمد استطيع تعديلها او تأييفها ان شئت, يعنى باستفيد من الاكواد التى يكتبها الاخوه فى المنتدى واحاول اظبطها على الى انا محتاجه وكنت طلبت فى موضوع سابق كود يعمل sumif لكن لم اتوصل الى شئ ,

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

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

والله من وراء القصد

sumif.rar

[أبوعبد الله]

أخي العزيز

شكراً على مشاركتك الفعالة وهذه إضافة بالكود تقوم بإضافة عمود المرجع بشكل تلقائي ودون تكرار ودون فراغات مع تمديد نطاق العمل الى 10000 صف لعلها تكون مفيدة .

تحياتي

أبو عبدالله

sumif.rar

[عادل حنفي]

السلام عليكم

اخي mselmy

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

وفقك الله

الاخ الحبيب ابو عبد الله منور بعد غياب

خالص تحياتي

تم تعديل يناير 19, 2009 بواسطه aah_aah2008

[أبوعبد الله]

أخي الحبيب / عادل

أشكرك على مرورك الكريم وكلماتك الجميلة ولك مني أجمل تحية.

ابو عبدالله

[mselmy]

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

[احمدزمان]

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

الأخ مسلمي

فكرة رائعة وتنفيذ جميل

الأستاذالقدير ابو عبدالله

دائما اعمالك جميلة ورائعة

جزاكم الله كل خير

[الســـــــاهر]

السلام عليكم

الاخت mselmy

نشكرك على هذا الكود الرائع

و ننتظر منك المزيد من العطاء

جزاك الله خير

الاخ الحبيب ابو عبد الله

مشكور اخوي على التعديل و ياليت لو في طريقة لتسريعه

لاني محتاجة ضروري

وطلبي هو

اريد تعديل الكود بحيث تكون القيم و المرجع في الصفحة الاخرى و ليس في نفس صفحة النتيجة

كون البيانات في الصفحة المسماه 44 في هذا المثال

وشكرا مرة اخرى

تم تعديل يناير 24, 2009 بواسطه الســـــــاهر

[الســـــــاهر]

السلام عليكم

للرفع

[رامي قلعجية]

في ٢٤‏/١‏/٢٠٠٩ at 22:10, الســـــــاهر said:

السلام عليكم

 

للرفع

وانا مع الساهر نفس القصة

[وجيه شرف الدين]

 

انظر الى هذا التعديل لعله يفى بالغرض

sumif.xls

[رامي قلعجية]

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

ارجو من عمالقة هذا المنتدى الجميل مساعدتي في حل هذه المشكلة حيث ان عندي شيت الاصناف بال عامود G بيحسب العدد المباع وبيجيب المعلومات من شيت المبيعات واريد بدلا من الدالة كود VBA الشرح داخل الملفو ارجو منكم المساعدة وشكرا لكم سلفا 

 

sumif vba.rar

[رامي قلعجية]

اخي وجيه شرف الدين اعجز عن شكري لك 

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

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

وهذا ملف للتوضيح

sumif 1.rar

تم تعديل مايو 31, 2019 بواسطه رامي قلعجية

[ابراهيم الحداد]

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

استخدم الكود التالى

لاحظ الكود سيتغرق تنفيذه حوالى 5 ثوانى او اكثر

Sub SumIfCod()
Dim ws As Worksheet, Sh As Worksheet
Dim C As Range, i As Long, x
Dim Rng As Range, LR As Long, y As Double
Set ws = Sheets("الاصناف")
Set Sh = Sheets("المبيعات")
LR = Sh.Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
T = Timer
i = 4
Do While ws.Range("A" & i) <> ""
x = ws.Range("A" & i).Value
y = WorksheetFunction.SumIf(Sh.Range("B2:B" & LR), x, Sh.Range("D2:D" & LR))
ws.Range("G" & i) = y
i = i + 1
Loop
MsgBox (Timer - T)
Application.ScreenUpdating = True
End Sub

 

[رامي قلعجية]

شكرا اخي ابراهيم على الرد السريع جعله الله في ميزان حسناتك 

الكود شغال بس زي ما حكيت بطيئ 

اللهم بارك لاخي ابراهيم حداد في نسله ورزقه من حيث لا يحتسب

تم تعديل يونيو 1, 2019 بواسطه رامي قلعجية

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

ممكن هذا الكود بدون SumIf

Option Explicit
Sub sum_if_by_code()
Application.ScreenUpdating = False
If ActiveSheet.Name <> "الاصناف" Then GoTo Exit_Sub
Dim SH_Mab As Worksheet: Set SH_Mab = Sheets("المبيعات")
Dim SH_Asnaf As Worksheet: Set SH_Asnaf = Sheets("الاصناف")
Dim Rg_Mab As Range
Dim Rg_Asnaf As Range
Dim My_cel_Mab As Range
Dim My_cel_Asnaf As Range
Dim m%: m = 0
SH_Mab.Select
Set Rg_Mab = SH_Mab.Range("b2", Range("b1").End(4))
SH_Asnaf.Select
SH_Asnaf.Range("G4", Range("G3").End(4)).ClearContents
Set Rg_Asnaf = SH_Asnaf.Range("a4", Range("a3").End(4))

 For Each My_cel_Asnaf In Rg_Asnaf
        For Each My_cel_Mab In Rg_Mab
          If My_cel_Asnaf = My_cel_Mab And _
          IsNumeric(My_cel_Mab.Offset(, 2)) Then _
          m = m + My_cel_Mab.Offset(, 2)
        Next
     My_cel_Asnaf.Offset(, 6) = m
     m = 0
 Next
Exit_Sub:
 Application.ScreenUpdating = True
End Sub

 

[رامي قلعجية]

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

اخي سليم في مشكلة بالكود بيحط رقم 0 في g4 

وبس ما بيعمل اي حاجة تانية

ارفقت ملف العمل عشان تعاين منو وشكرا ليك 

ولأمثالك مع فائق احترامي ليك 

sumif 2.rar

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

اي يعني لما بيكون المجموع صفر يفترض ان يضع صفر

على كل حال اذا كنت لا تريد الصفر يمكن التعديل

وذلك باضافة شيء بسيط  على سطر واحد بالكود ( ما بين اشارات +++++)

Option Explicit
Sub sum_if_by_code()
Application.ScreenUpdating = False
If ActiveSheet.Name <> "الاصناف" Then GoTo Exit_Sub
Dim SH_Mab As Worksheet: Set SH_Mab = Sheets("المبيعات")
Dim SH_Asnaf As Worksheet: Set SH_Asnaf = Sheets("الاصناف")
Dim Rg_Mab As Range
Dim Rg_Asnaf As Range
Dim My_cel_Mab As Range
Dim My_cel_Asnaf As Range
Dim m%: m = 0
SH_Mab.Select
Set Rg_Mab = SH_Mab.Range("b2", Range("b1").End(4))
SH_Asnaf.Select
SH_Asnaf.Range("G4", Range("G3").End(4)).ClearContents
Set Rg_Asnaf = SH_Asnaf.Range("a4", Range("a3").End(4))

 For Each My_cel_Asnaf In Rg_Asnaf
        For Each My_cel_Mab In Rg_Mab
          If My_cel_Asnaf = My_cel_Mab And _
          IsNumeric(My_cel_Mab.Offset(, 2)) Then _
          m = m + My_cel_Mab.Offset(, 2)
        Next
   Rem ++++++++++++++++++++++++++++++++++++++++++++++
     My_cel_Asnaf.Offset(, 6) = IIf(m = 0, vbNullString, m)
  Rem++++++++++++++++++++++++++++++++++++++++++++
     m = 0
 Next
Exit_Sub:
 Application.ScreenUpdating = True
End Sub

 

[وجيه شرف الدين]

انظر الى هذا التعديل لعله يفى بالغرض

التعديلsumif.xls

[رامي قلعجية]

استاذي سليم انا شاكر ليك وارجو منك سعة صدر 

انا وضحت الفكرة اكتر في المرفق الي تحت 

وان اخطأت في توصيل رسالتي صحيحة فهذا من جهلي اسف اخي الكريم

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

لانه عند نسخ الكود ينسخ غلط لان الويندوز بيغير الكود وبيلعب ببعض الاسطر 

sumif 3.rar

تم تعديل يونيو 1, 2019 بواسطه رامي قلعجية

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

[رامي قلعجية]

اخي جرب الان ارسلت الملف من دون ماكرو

sumif4.rar

[رامي قلعجية]

6 ساعات مضت, وجيه شرف الدين said:

انظر الى هذا التعديل لعله يفى بالغرض

التعديلsumif.xls 58 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 1 download

اخي وجيه شرف الدين

شكرا جزيلا لك ولسليم حاصبيا اللهم اعن من اعانني وهدي من اعانني ورزقه رزقا حلا طيبا

تم تعديل يونيو 1, 2019 بواسطه رامي قلعجية

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

كود جديد بقوم بما تريده  تم تغيير اسماء الضفحات لسببين

1- لا أطيق العمل بالكود مع اللغة العربية لصعوبة اتجاهات الكتابة (تارة من الشمال اى اليمين وطوراً بالعكس)

2-سهولة نسخ الكود بدون ان تظهر حروف غريبة)

Option Explicit
Sub Give_data()
Dim Dict As New Dictionary
Dim Itm#, i%: i = 2
Dim K
Dim SA As Worksheet: Set SA = Sheets("Salim")
Dim Mab As Worksheet: Set Mab = Sheets("Mabi3at")
Dim X#: X = Application.CountA(Mab.Range("b:b"))
  With SA.Range("A4").Resize(X)
    .ClearContents
    .Offset(, 6).ClearContents
  End With

  Do Until Mab.Range("b" & i) = vbNullString
       K = Mab.Range("b" & i): Itm = Mab.Range("d" & i)
      If Not Dict.Exists(K) Then
       Dict.Add K, Itm
       Else
        Dict(K) = Dict(K) + Itm
      End If
      i = i + 1
   Loop
   With SA.Range("a4").Resize(Dict.Count)
  .Value = Application.Transpose(Dict.Keys)
  .Offset(, 6).Value = Application.Transpose(Dict.Items)
  End With
Dict.RemoveAll
End Sub

الملف

 

SUM_WITH DICTIONARY.xlsm

[رامي قلعجية]

رائع اخي سليم ولكن عند اضافة صنف في صفحة الاصناف اذا لم يكن عليه حركة في المبيعات عما ينحذف ولا اريد حذفه لانني اكثر الاحيان ادخل الاصناف ولا يوجد عليها حركة واذا امكن عامود H و i يكون بالكود اشكرك جزيلا لمجهودك الرائع 

في صفحة salim

الباقي من الاصناف حيكون العدد المباع ناقص العدد 

و سعر البضاعة الباقية حيكون الباقي من الاصناف ضرب الكلفة 

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

تم تعديل يونيو 1, 2019 بواسطه رامي قلعجية

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

16 دقائق مضت, رامي قلعجية said:

رائع اخي سليم ولكن عند اضافة صنف في صفحة الاصناف اذا لم يكن عليه حركة في المبيعات عما ينحذف ولا اريد حذفه لانني اكثر الاحيان ادخل الاصناف ولا يوجد عليها حركة واذا امكن عامود H و i يكون بالكود اشكرك جزيلا لمجهودك الرائع 

 

أي صنف تزيده او تعدل قيمته يظهر في النتيجة

طيعاً بعد تنفيذ الكود بالضغط على الزر

ملاحظة الكود يتوقف عن العمل عند اي صف فارغ في شيت الاصناف لذلك لا تترك اي فراغ بين البيانات

و اذا اردت حذف صنف من الاصناف عليك حذف (الصف او الصفوف) بالكامل 

لا لزوم لترتيت الاصناف لان الكود لا ينظر الى المكرر مع انه يقوم بجمع القيم للمكررين مثلا يمكن في اخر صف  ادراج الصنف1 و بعده صنف 50  ثم صنف 4 الخ....