JavaScript is not enabled!...Please enable javascript in your browser

جافا سكريبت غير ممكن! ... الرجاء تفعيل الجافا سكريبت في متصفحك.

-->
الصفحة الرئيسية

اكسيل | كيفية حساب مجموع الخلايا اوتوماتيكيا بدون معادلات وتقليل حجم البيانات

بسم الله الرحمن الرحيم

اهلا بكم متابعى موقع عالم الاوفيس

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


درس جديد وكود جديد من مكتبة اكواد اكسل Excel VBA

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

الكود 


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("c2:c5000")) Is Nothing Then
Cells(Target.Row, 4) = Cells(Target.Row, 2) * Cells(Target.Row, 3)
End If
End Sub

نلاحظ من خلال هذا الكود اننا استخدمنا الدالة Intersect وهى دالة تقاطع العمود مع الصف واستخدمنا ايضا Target وذلك لتحديد الخلية الهدف 

كود سهل وبسيط جدا ان شاء الله هيفيدكم فى شغلكم

عزيزى الزائر 
لاتقرأ ... وترحل
ضع بصمتك .... شاركنا برائيك
لمشاهدة شرح الية عمل الكود يرجى مشاهدة الفيديو


لتحميل ملف العمل من هنا


author-img

Emad ghazi

تعليقات
  • kaream emad photo
    kaream emad1 مايو 2020 في 9:18 ص

    ممتاز

    إرسال تعليقحذف التعليق
    • Unknown photo
      Unknown1 مايو 2020 في 12:27 م

      آلسلام شكرا. لا يعمل الكود اثر نسخ مجموعة من الاعداد شيت آخر. [Cترل]+[V] . فماهو الحل؟

      إرسال تعليقحذف التعليق
      • Unknown photo
        Unknown1 مايو 2020 في 12:30 م

        آلسلام شكرا. لا يعمل الكود اثر اصلاحه . فماهو الحل؟

        Public Sub worksheet_change(ByVal ligneReleve As Range)
        If Not Intersect(ligneReleve, Range("a6:a5000")) Is Nothing Then
        'Dim ligneReleve As Integer
        'ligneReleve = 6
        'Range("b5") = "codeEnreg"
        'Range("c5") = "codeBanq"
        'Range("d5") = "codeOpératInterne"
        'Range("e5") = "codeAgence "
        'Range("i5") = "numéroCOmpte"
        'Range("j5") = "Anciencodeopé"
        'Range("k5") = "DateO"
        'Range("m5") = "dateV"
        'Range("n5") = "Libéllé"
        'Range("p5") = "N pièces"
        'Range("s5") = "Montant"
        'Range("u5") = "CnumDébit"
        'Range("v5") = "CnumCrédit"
        'Range("AA5") = "CodeUnDateMontant"
        'Range("Ab5") = "CodedeuxNChequeetMontant"


        'While Range("b" & ligneReleve) <> ""
        'For ligneReleve = 4808 To 4916 ' a enlever si le fichier est rempli
        'If IsEmpty(Range("b" & ligneReleve)) Then
        'Range("b" & ligneReleve) = 0
        'Else
        Range("b" & ligneReleve) = Int(CDbl(Mid(Range("a" & ligneReleve), 1, 2)))
        Range("c" & ligneReleve) = Int(CDbl(Mid(Range("a" & ligneReleve), 3, 5)))
        Range("d" & ligneReleve) = (Mid(Range("a" & ligneReleve), 8, 4))
        Range("e" & ligneReleve) = Int(CDbl(Mid(Range("a" & ligneReleve), 12, 5)))
        Range("i" & ligneReleve) = Int(CDbl(Mid(Range("a" & ligneReleve), 22, 10)))
        Range("j" & ligneReleve) = Int(CDbl(Mid(Range("a" & ligneReleve), 32, 3)))
        Range("k" & ligneReleve) = DateSerial(Int(CDbl(Mid(Range("a" & ligneReleve), 39, 2))), Int(CDbl(Mid(Range("a" & ligneReleve), 37, 2))), Int(CDbl(Mid(Range("a" & ligneReleve), 35, 2))))
        Range("m" & ligneReleve) = DateSerial(Int(CDbl(Mid(Range("a" & ligneReleve), 47, 2))), Int(CDbl(Mid(Range("a" & ligneReleve), 45, 2))), Int(CDbl(Mid(Range("a" & ligneReleve), 43, 2))))
        Range("n" & ligneReleve) = (Mid(Range("a" & ligneReleve), 49, 31))
        Range("p" & ligneReleve) = Mid(Range("a" & ligneReleve), 82, 7)
        Range("s" & ligneReleve) = (CDbl(VBA.Replace(Mid(Range("a" & ligneReleve), 91, 14), ".", ",")))
        If (Range("s" & ligneReleve)) < 0 Then Range("u" & ligneReleve) = -(Range("s" & ligneReleve)) Else Range("u" & ligneReleve) = 0
        If (Range("s" & ligneReleve)) > 0 Then Range("v" & ligneReleve) = (Range("s" & ligneReleve)) Else Range("v" & ligneReleve) = 0
        Range("AA" & ligneReleve) = Range("k" & ligneReleve) & "_" & (Math.Abs(Range("u" & ligneReleve)) + Math.Abs(Range("v" & ligneReleve)))
        Range("ab" & ligneReleve) = Range("p" & ligneReleve) & "_" & (Math.Abs(Range("u" & ligneReleve)) + Math.Abs(Range("v" & ligneReleve)))

        End If
        'Next ' a enlever si le fichier est rempli
        'ligneReleve = ligneReleve + 1
        'Wend
        End Sub

        إرسال تعليقحذف التعليق
        • ahmrawan810@gmail.com photo
          ahmrawan810@gmail.com8 مايو 2020 في 8:40 م

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

          إرسال تعليقحذف التعليق
          • Unknown photo
            Unknown10 يوليو 2020 في 11:35 م

            الكود لايعمل الرجاء اصلاح الخلل

            إرسال تعليقحذف التعليق
            الاسمبريد إلكترونيرسالة