الرئيسية | مايكروسوفت اوفيس | مايكروسوفت اكسل | إيجاد القيم المتشابهه بين خليتين – مايكروسوفت اكسل VBA

إيجاد القيم المتشابهه بين خليتين – مايكروسوفت اكسل VBA

هل تريد معرفة إن كان هناك كلمة /كلمات مشتركة بين خليتين واستخراج هذه الكلمة/الكلمات؟ في هذا المقال سوف نستعرض النقاط التالية للقيام بهذه المهمة:

  1. إضافة Module جديد لملف الاكسل.
  2. اضافة كود VBA الخاص بالدالة التي ستستخرج الكلمات المتشابهه.
  3. كيفية استخدام الدالة.
  4. كيفية حل مشكلة Case Sensitive عند التعامل مع النصوص الإنجليزية.
  5. مثال يبرز فائدة الدالة في الواقع العملي.
  6. كيفية المقارنة بين محتوى 3 خلايا واستخراج الكلمات المتشابهه بين هذه الخلايا.

استخلاص المتشابهات بين الخلايا اكسل 01

إنشاء Module جديد من نافذة VBA

  • من قائمة المطور/Developer نختار Visual Basic
    استخلاص المتشابهات بين الخلايا اكسل 02
  • من القائمة Insert نختار Module
    استخلاص المتشابهات بين الخلايا اكسل 03

اضافة كود VBA الخاص بالدالة التي ستستخرج الكلمات المتشابهه.

نقوم بلصق الكود التالي في نافذة Module

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Function CompareTwoValues(v1 As Variant, v2 As Variant) As String
 
    Dim i As Long, j As Long, w1, w2, s As String
 
    If (v1 = 0 And v2 = 0) Then
 
        s = ""
    Else
 
        w1 = Split(v1, " ")
        w2 = Split(v2, " ")
 
        For i = LBound(w1) To UBound(w1)
            For j = LBound(w2) To UBound(w2)
                If Trim(w1(i)) = Trim(w2(j)) Then
                    s = s & " " & Trim(w1(i))
                    Exit For
                End If
            Next j
        Next i
    End If
 
    CompareTwoValues = Mid(s, 1)
 
End Function

كيفية إستخدام الدالة الجديدة CompareTwoValues

نعود الى شاشة الاكسل ونستخدم الدالة الجديدة CompareTwoValues سواء من خلال

  • شاشة Insert Function وسنجدها مدرجة تحت تصنيف User Defined. أو
    استخلاص المتشابهات بين الخلايا اكسل 04
  • كتابة علامة =، ثم البدء في كتابة الدالة لنجد انها اصبحت متاحة ضمن قائمة الدوال
    استخلاص المتشابهات بين الخلايا اكسل 05

ثم ندخل مرجع الخليتين المراد استخراج القيم المتشابهه بينهم -في حالة وجود تشابه-.

=CompareTwoValues(B3;C3)

كيفية حل مشكلة Case Sensitive عند التعامل مع النصوص الإنجليزية.

لعلكم لاحظتم أن الدالة تراعي حالة الاحرف case sensitive عند المقارنة بين النصوص باللغة الانجليزية، فهل توجد طريقة لإلغاء هذه الخاصية بحيث تعالج الدالة Ali بشكل مساوي ل ali؟

استخلاص المتشابهات بين الخلايا اكسل 06

نعم، يمكننا الغاء خاصية مراعاة حالة الاحرف عند المقارنة من خلال اضافة السطر التالي قبل الكود

1
Option Compare Text

استخلاص المتشابهات بين الخلايا اكسل 07

مثال توضيحي لكيفية الاستفادة من الدالة في الواقع العملي

فيما يلي قائمة بأسماء المنتجات والكميات المتاحة لكل منتج؛ ونريد معرفة رصيد المنتجات التي تشتمل على «Cartridge HP»

استخلاص المتشابهات بين الخلايا اكسل 08

لنحصل بعد استخدام الدالة على المنتجات التي تشتمل على كلمة Cartridge أو/و كلمة HP ومن ثم نستطيع استخدام اداة الفلتر/التصفية Filter لعرض المنتجات التي تشتمل على الكلمات Cartridge HP، كالتالي

استخلاص المتشابهات بين الخلايا اكسل 09

هل تريد إستخراج القيم المتشابهه بين 3 خلايا؟

يمكنك إستخدام الكود التالي، مع إتباع نفس الخطوات السابقة.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Function CompareThreeValues(v1 As Variant, v2 As Variant, v3 As Variant) As String
Dim i As Long, j As Long, k As Long, w1, w2, w3, s As String
 
If (v1 = 0 And v2 = 0 And v3 = 0) Then
s = ""
Else
w1 = Split(v1, " ")
w2 = Split(v2, " ")
w3 = Split(v3, " ")
 
For i = LBound(w1) To UBound(w1)
    For j = LBound(w2) To UBound(w2)
        For k = LBound(w3) To UBound(w3)
            If Trim(w1(i)) = Trim(w2(j)) Then
                If Trim(w2(j)) = Trim(w3(k)) Then
                    s = s & " " & Trim(w1(i))
                    Exit For
                End If
            End If
        Next k
    Next j
Next i
End If
CompareThreeValues = Mid(s, 1)
 
End Function

مصدر الاكواد : Compare two text cells and extract common text words

تحميل ملف العمل : إيجاد القيم المتشابهه بين خليتين

عن عبير محمد

بكالريوس علوم حاسب آلي - جامعة أم القرى - المملكة العربية السعودية .. مهتمة بالتقنية .. مدربة حاسب آلي.

شاهد أيضاً

ما هو الـ Personal Workbook ؟ مايكروسوفت اكسل

الـ Personal Workbook عبارة عن ملف اكسل يُستخدم لتخزين أكواد VBA التي نريد الإستفادة منها ...