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

في موضوع لأخونا إسلام عبد الله على الرابط التالي من هنا قدم إسلام طريقة جميلة لدمج الخلايا الفارغة بين النصوص

لذا رأيت أن أقدم لكم كود آخر يقوم بدمج الخلايا ولكن للنصوص المتشابهة ..
بفرض أن لديك بيانات بهذا الشكل في العمود الأول


والمطلوب أن تكون النتيجة بهذا الشكل








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

ولتنفيذ ذلك قم بوضع الكود التالي في موديول عادي ، ثم اربط الكود المسمى Test_MergeSimilarCells بزر أمر .. حيث يحتوي الكود على النطاق المطلوب دمج البيانات فيه

Sub Test_MergeSimilarCells()
    Dim ws          As Worksheet
    Dim rng         As Range
    Dim lr          As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = ws.Range("A1:A" & lr)

    MergeSimilarCells rng
End Sub

Sub MergeSimilarCells(workRng As Range)
    Dim rng         As Range
    Dim xRows       As Integer
    Dim i           As Integer
    Dim j           As Integer

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        xRows = workRng.Rows.Count
    
        For Each rng In workRng.Columns
            For i = 1 To xRows - 1
                For j = i + 1 To xRows
                    If rng.Cells(i, 1).Value <> rng.Cells(j, 1).Value Then Exit For
                Next j
                workRng.Parent.Range(rng.Cells(i, 1), rng.Cells(j - 1, 1)).Merge
                i = j - 1
            Next i
        Next rng
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

حمل الملف من هنا


وأترككم في رعاية الله
كان معكم أخوكم في الله / ياسر خليل أبو البراء