Note: The other languages of the website are Google-translated. Back to English

كيف تحسب عدد المرات التي يتم فيها تغيير الخلية في إكسيل؟

لحساب عدد المرات التي يتم فيها تغيير خلية محددة في Excel ، يمكن أن تساعد رموز VBA المتوفرة في هذه المقالة.

قم بحساب عدد المرات التي يتم فيها تغيير الخلية برمز VBA


قم بحساب عدد المرات التي يتم فيها تغيير الخلية برمز VBA

يمكن أن تساعدك رموز VBA التالية في حساب عدد المرات التي يتم فيها تغيير خلية محددة في Excel.

1. في ورقة العمل التي تحتوي على خلية واحدة أو أكثر تحتاج إلى حساب التغيير الإجمالي لها ، انقر بزر الماوس الأيمن فوق علامة تبويب الورقة ، ثم انقر فوق عرض الرمز من قائمة السياق. انظر لقطة الشاشة:

2. في الافتتاح ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، انسخ والصق أحد رموز VBA التالية في ملف رمز نافذة حسب احتياجاتك.

كود فبا 1: تعقب التغييرات لخلية واحدة فقط

Dim xCount As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If Target = Range("B9") Then
        xCount = xCount + 1
        Range("C9").Value = xCount                                     
    End If
    Application.EnableEvents = False
    Set xRg = Application.Intersect(Target.Dependents, Me.Range("B9"))
    If Not xRg Is Nothing Then
        xCount = xCount + 1
        Range("C9").Value = xCount
    End If
    Application.EnableEvents = True
End Sub

ملاحظة: في الكود ، B9 هي الخلية التي تحتاجها لحساب تغييراتها ، و C9 هي الخلية لملء نتيجة العد. الرجاء تغييرها كما تريد.

رمز فبا 2: تعقب التغييرات لخلايا متعددة في عمود

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220916
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("B9:B1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 1)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub

ملاحظة: في هذا الخط "ضبط xRRg = xCell.Offset (0، 1)"، الرقم 1 يمثل عدد الأعمدة المراد إزاحتها إلى يمين مرجع البداية (هنا مرجع البداية هو العمود B، والعدد الذي تريد إرجاعه موجود في العمود C الذي يقع بجوار العمود B). إذا كنت بحاجة إلى إخراج النتائج في العمود S، قم بتغيير الرقم 1 إلى 10.

من الآن فصاعدًا ، عندما تتغير الخلية B9 أو أي خلية في النطاق B9: B1000 ، سيتم فرض العدد الإجمالي للتغييرات وتعبئته تلقائيًا في الخلية المحددة.


أفضل أدوات إنتاجية المكتب

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع
فرز التعليقات حسب
التعليقات (22)
لا يوجد تقييم. كن أول من يقيم!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكراً جزيلاً ! هذا يعمل بشكل رائع.

ولكن كيف يمكنك الحصول على نفس الوظيفة / القاعدة للعمل مع نطاق من الخلايا ، على طول عمود بأكمله ، على سبيل المثال؟

لدي قائمة بجهات الاتصال الخاصة بعملي في صفوف مختلفة ، مع تفاصيل الاتصال الخاصة بهم في أعمدة مختلفة ، وأريد إضافة عمود يسجل ويحسب عدد المرات التي يتم فيها تغيير خلية معينة على طول كل صف. الكود الذي قدمته يعمل بشكل رائع ، ولكن لخلية واحدة فقط في كل مرة!

أنا جديد في VBA ، لذا سأكون ممتنًا لدعمك كثيرًا.

حاولت إضافة نطاق من الخلايا إلى الشفرة ، لذا بدلاً من "B9" و "C9" ، كما هو موضح في المثال أعلاه ، لعبت مع أشكال مختلفة مثل "B: B" أو "C: C" أو "B9 : B1000 "و" C9: C1000 "، دون أي نجاح.

يرجع الفضل في ذلك مسبقا،
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جان ،
الرجاء محاولة رمز VBA أدناه. أتمنى أن تساعد. شكرا على تعليقك.

ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
خافت xRg كمدى ، xCell كمدى
خافت xSRg ، xRRg كنطاق
خافت xFNum وطول

تعيين xSRg = Range ("B9: B1000")
تعيين xRRg = Range ("C9: C1000")

Application.EnableEvents = خطأ
على خطأ استئناف التالي
بالنسبة إلى xFNum = 1 إلى xSRg.count
إذا كان الهدف = xSRg.Item (xFNum) ثم
xRRg.Item (xFNum) .Value = xRRg.Item (xFNum) .Value + 1
Application.EnableEvents = صحيح
خروج الفرعية
إنهاء حالة
التالي xFNum
Application.EnableEvents = صحيح
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كريستال ،

هذا رائع ، لقد استخدمت هذا في المصفوفة الخاصة بي على أحد الأعمدة ولكني كافحت لتكرار ذلك عبر عدة أعمدة. هل لديك حل؟

شكرا مقدما
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل يمكنك تقديم مجموعة التعليمات البرمجية بالكامل؟ أفترض أن كود Crystal يتكامل مع كود آخر؟ شكرًا
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كريستال ،

لدي مشكلة مع الكود. إذا كانت الخلية على سبيل المثال ، إذا قمت بالدخول

B9 كـ "Apple" ثم تزيد C9 بمقدار 1
B10 كـ "كرة" ثم تزيد C10 بمقدار 1
ومع ذلك ، إذا دخلت
B11 باسم "Apple" مرة أخرى ، ستتم زيادة C9 بمقدار 1 وليس C11

يبدو أنه يزيد الصف مع التكرار الأول للقيمة وليس الصف الذي تم تحريره الفعلي.

هل هناك طريقة لزيادة الخلية في نفس الصف فقط وليس الصف السابق؟

شكر.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل هذا الرقم. أنا أيضًا مهتم بهذا لفحص خلايا متعددة. لم أجربها بعد.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كيفن،

يمكن أن تساعدك الكود التالي في حل المشكلة. شكرا على تعليقك.
ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
خافت xRg كمدى ، xCell كمدى
خافت xSRg ، xRRg كنطاق
خافت xFNum وطول

تعيين xSRg = Range ("B9: B1000")
تعيين xRRg = Range ("C9: C1000")

Application.EnableEvents = خطأ
على خطأ استئناف التالي
بالنسبة إلى xFNum = 1 إلى xSRg.count
إذا كان الهدف = xSRg.Item (xFNum) ثم
xRRg.Item (xFNum) .Value = xRRg.Item (xFNum) .Value + 1
Application.EnableEvents = صحيح
خروج الفرعية
إنهاء حالة
التالي xFNum
Application.EnableEvents = صحيح
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
Gracias de antemano por el aporte، muy útil، sin blockgo، quisiera pedir su ayuda a fin de reniciar el contador a cero cuando sea necesario، es decir، luego de contar las veces que se modificó la celda، quisiera llevarla a cero y volver a كومينزار. podrás ayudarme. غراسياس!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا بكم جميعا،

الحل كما هو مذكور تحت عنوان "عدد مرات تغيير الخلية برمز VBA" جيد إذا كنا نتتبع التغييرات على خلية واحدة فقط. يرجى اقتراح ما هي التعديلات اللازمة ، إذا كان التعقب يجب أن يتم لخلايا متعددة. في حالة وجود خلايا متعددة ، يجب أن يظهر العداد المتزايد بجوار الخلية التي يتم تعقب التغيير في القيمة لها.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
نتطلع إلى المساعدة والمساعدة للحصول على رمز VBA محدد ، والذي يمكن تطبيقه على خلايا متعددة في ورقة عمل واحدة.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا شيجو ،
الرجاء محاولة رمز VBA أدناه. شكرا على التعليق.

ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
خافت xRg كمدى ، xCell كمدى
خافت xSRg ، xRRg كنطاق
خافت xFNum وطول

تعيين xSRg = Range ("B9: B1000")
تعيين xRRg = Range ("C9: C1000")

Application.EnableEvents = خطأ
على خطأ استئناف التالي
بالنسبة إلى xFNum = 1 إلى xSRg.count
إذا كان الهدف = xSRg.Item (xFNum) ثم
xRRg.Item (xFNum) .Value = xRRg.Item (xFNum) .Value + 1
Application.EnableEvents = صحيح
خروج الفرعية
إنهاء حالة
التالي xFNum
Application.EnableEvents = صحيح
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
فريق،

عندما حاولت استخدام:

ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
خافت xRg كمدى ، xCell كمدى
خافت xSRg ، xRRg كنطاق
خافت xFNum وطول

تعيين xSRg = Range ("B9: B1000")
تعيين xRRg = Range ("C9: C1000")

قم بتغيير خلايا النطاق والهدف بعناية مقابل P2: P200 و X2: X200 على التوالي ، فأنا لا أقوم بتغيير عدد الخلايا في X Column على الرغم من محاولتي تغيير الخلايا عبر صفوف متعددة عبر P2: P200.

أي مساعدة سيكون موضع تقدير كبير.

التحيات
JT
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل يمكن لأي شخص مساعدتي في تحقيق الترميز لحساب الوقت الذي تم فيه تغيير الخلية إلى "إعادة التحقق" ويمكن تطبيق ذلك على دخول العمود.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
Quisiera que me ayudaran a reniciar el contador a cero cuando lo Requiera، es decir، la celda c9 llevarla a cero y comenzar a contar b9 nuevamente.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا فيليكس ماريو ،
الرجاء إضافة الكود التالي بعد الرمز الموجود في هذا المنشور. عندما تحتاج إلى إعادة تعيين الخلية ، انقر فوق أي كلمات في الرمز ، ثم اضغط على المفتاح F5 لتشغيلها.
Sub CleaRCount()
'Updated by Extendoffice 20220527
    xCount = 0
    Range("c9") = 0
End Sub
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كريستال

أواجه نفس المشكلة مثل RedDragon. أحاول تتبع تغييرات التاريخ ، على سبيل المثال عندما يرسل وكيل حالة إلى مديره ، يقوم بإدخال تاريخ يدويًا - يمكن أن يحدث هذا أكثر من مرة في إحدى الحالات ، لذلك أحاول استخدام هذا الرمز لإظهار عدد المرات التي تمت فيها كل حالة تم إرسالها إلى مدير. مشاكلي هي:

1) إذا تم إرسال حالات متعددة إلى المديرين في يوم واحد ، فإن العداد يزيد فقط في المرة الأولى من ذلك التاريخ ، وليس بجوار الصفوف المعنية.
2) في كل مرة أخرج فيها من الورقة ، وأعيد فتحها ، وأعدِّل التاريخ ، يعيد العداد تعيينه إلى "1" - كيف يمكنني ترحيله وعدم إعادة تعيينه عند إعادة فتح الورقة؟

أي مساعدة موضع تقدير كبير وأشكرك كثيرًا على ما قمت به حتى الآن.

جادجوس
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جادجوس ،
أعتذر على الإزعاج. يمكن أن يقدم لك رمز VBA التالي خدمة. يرجى محاولة إعطائها.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220916
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("B9:B1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 1)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أحاول استخدام الكود أدناه وهو يعمل ، لكني أستخدمه لتتبع التغييرات في التواريخ ، نظرًا لأن بعض التواريخ هي نفسها في كل مرة أقوم فيها بتغيير تاريخ هو نفسه بالنسبة للآخر في العمود الذي يحسب مرة أخرى.
أحاول استخدام أحدث رمز ولكنه لا يفعل شيئًا عندما أحاول ذلك. شكرًا على هذا الرمز العظيم!

ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
خافت xRg كمدى ، xCell كمدى
خافت xSRg ، xRRg كنطاق
خافت xFNum وطول

تعيين xSRg = Range ("I3: I1000")
تعيين xRRg = النطاق ("S3: S1000")

Application.EnableEvents = خطأ
على خطأ استئناف التالي
بالنسبة إلى xFNum = 1 إلى xSRg.Count
إذا كان الهدف = xSRg.Item (xFNum) ثم
xRRg.Item (xFNum) .Value = xRRg.Item (xFNum) .Value + 1
Application.EnableEvents = صحيح
خروج الفرعية
إنهاء حالة
التالي xFNum
Application.EnableEvents = صحيح
نهاية الفرعية
العدد الفرعي ()
'تم التحديث بواسطة Extendoffice 20220527
xCount = 0
النطاق ("S3") = 0
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
يمكن أن يقدم لك رمز VBA التالي خدمة. يرجى محاولة إعطائها.
ملاحظة: في هذا الخط "ضبط xRRg = xCell.Offset (0، 10)"، الرقم "10يمثل "عدد الأعمدة المراد إزاحتها إلى يمين مرجع البداية (هنا مرجع البداية هو العمود I، والعدد الذي تريد إرجاعه موجود في العمود S).

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220919
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("I3:I1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 10)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكرا كريستال ، يعمل بشكل رائع!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أولا كريستال ،

vi que você tem ajudado o pessoal com código vba. será q vc poderia me dar uma ajuda tb؟

eu tenho uma coluna B e C onde eu preencho cada uma delas diariamente ... o que eu gostaria de saber é quantas vezes eu mudo o campo B2 até mudar o campo C2 e manter esse valor de alterações no campo D2

مثال: eu alterei o campo B2 5 vezes seguidas أكلت ألترار o C2

د 2 = 5

الكميات vezes eu alterei o campo C2 até voltar a alternar B2
مثال: Alterei o campo C2 2 vezes seguidas e voltei a alterar o campo B2
E2 = 2

eu gostaria de manter o valor máximo dessa Sequência، só voltando a alterar o campo D2 e ​​E2 se a sequencia de alterações em B2 e C2 fossem maior do que 5 e 2، como no exemplo que eu dei.

espero que tenha ficado claro os exemplos. ahahhah ... abraços
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا واغنر سيزار ،
قد يساعد رمز VBA التالي. يرجى محاولة إعطائها. شكرًا لك.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220916
    Dim xSRg As Range
    Dim xRRg As Range
    On Error Resume Next
    
    Set xSRg = Range("B2:B10")
    Set xCell = Intersect(xSRg, Target)
    If Not xCell Is Nothing Then
        Application.EnableEvents = False
        Set xCell = xCell.Range("A1")
        Set xRRg = xCell.Offset(0, 2)
        xRRg.Value = xRRg.Value + 1
        If xRRg.Value > 5 Then
            xRRg.Value = 1
        End If
        Application.EnableEvents = True
    End If
    
    Set xSRg = Range("C2:C10")
    Set xCell = Intersect(xSRg, Target)
    If Not xCell Is Nothing Then
        Application.EnableEvents = False
        Set xCell = xCell.Range("A1")
        Set xRRg = xCell.Offset(0, 2)
        xRRg.Value = xRRg.Value + 1
        If xRRg.Value > 2 Then
            xRRg.Value = 1
        End If
        Application.EnableEvents = True
    End If
        
End Sub
لا توجد تعليقات منشورة هنا حتى الآن
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL