Макрос на сопоставление данных из одной ячейки на данные второй ячейки

Sub MMM()
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 3).End(xlUp).Row
 For i = LR To 7 Step -1
    For j = i - 1 To 7 Step -1
        If Cells(i, 3) = Cells(j, 3) And Cells(i, 6) = Cells(j, 6) And Cells(i, 7) = Cells(j, 7) And Cells(i, 8) = Cells(j, 8) And Cells(i, 9) = Cells(j, 9) Then
            If InStr(Cells(i, 4).Value, Cells(j, 4).Value) = 0 Then Cells(i, 4).Value = Cells(i, 4).Value & "," & Chr(10) & Cells(j, 4).Value
             If InStr(Cells(i, 5).Value, Cells(j, 5).Value) = 0 Then Cells(i, 5).Value = Cells(i, 5).Value & "," & Chr(10) & Cells(j, 5).Value
            Cells(j, 4) = Cells(i, 4)
            Cells(j, 5) = Cells(i, 5)
           Rows(i).Delete
           Exit For
         End If
        
    Next
 Next
 Application.ScreenUpdating = True
 
End Sub

Public Sub www()
Application.ScreenUpdating = False
    Dim arr()       As Variant
    a = UBound(Split(Cells(7, 4), ",")) + 1
    b = UBound(Split(Cells(7, 5), ",")) + 1
    ReDim arr(1 To a * b, 1 To 2)
    For i = 1 To a
        For j = 1 To b
            n = n + 1
            arr(n, 1) = Split(Cells(7, 4), ",")(i - 1)
            arr(n, 2) = Split(Cells(7, 5), ",")(j - 1)
        Next
    Next
    Range(Cells(7, 2), Cells(7, 9)).Copy _
            Destination:=Range(Cells(9, 2), Cells(8 + a * b, 9))
    Cells(9, 4).Resize(a * b, 2) = arr
    Application.ScreenUpdating = True
End Sub

Private Sub Accelerate_Excel(bFlag As Boolean)
   With Application
      .ScreenUpdating = Not bFlag
      .Calculation = IIf(Not bFlag, xlCalculationAutomatic, xlCalculationManual)
      .EnableEvents = Not bFlag
      'If Workbooks.Count Then ActiveWorkbook.ActiveSheet.DisplayPageBreaks = Not bFlag
'      .DisplayStatusBar = Not bFlag
      .DisplayAlerts = Not bFlag
   End With
End Sub