اذهب الي المحتوي
أوفيسنا

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


mselmy
إذهب إلى أفضل إجابة Solved by ابراهيم الحداد,

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

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

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

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

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

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

sumif.rar

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

أخي العزيز

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

تحياتي

أبو عبدالله

sumif.rar

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

السلام عليكم

اخي mselmy

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

وفقك الله

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

خالص تحياتي

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

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

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

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

الأخ مسلمي

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

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

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

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

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

السلام عليكم

الاخت mselmy

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

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

جزاك الله خير

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

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

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

وطلبي هو

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

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

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

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

  • 10 years later...

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

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

 

sumif vba.rar

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

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

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

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

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

sumif 1.rar

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

  • أفضل إجابة

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

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

لاحظ الكود سيتغرق تنفيذه حوالى 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

 

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

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

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

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

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

ممكن هذا الكود بدون 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

 

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

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

اخي سليم في مشكلة بالكود بيحط رقم 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

 

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

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

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

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

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

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

sumif 3.rar

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

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

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

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

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

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

تم تعديل بواسطه رامي قلعجية
  • Like 1
رابط هذا التعليق
شارك

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

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

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

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

في صفحة salim

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

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

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

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

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

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

 

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

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

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

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

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

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

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