Нужен код VBA для объединения строк, если строки AF одинаковы

Question

Мне нужен код VBA, который будет объединять строки, если, например, строки 4 и 5 имеют одинаковые значения в столбцах A:F. Однако тогда мне нужно, чтобы столбец G был разделен. G4 остается как G4, но затем G5 становится H5. Я сделал некоторое кодирование VBA (и уже изменил рабочий лист, как показано в моем коде ниже), но я понятия не имею, с чего начать со следующего подпункта.

Вот что у меня есть:

Это то, что мне нужно:

Sub DeleteRowWithContents()
    Last = Cells(Rows.Count, "J").End(xlUp).Row
    For i = Last To 1 Step -1
        If (Cells(i, "N").Value) = "Abandon Order" Or (Cells(i, "N").Value) = "Inactive" Then
            Cells(i, "A").EntireRow.Delete
        End If
    Next i
End Sub

Sub DeleteNoNeedColumns ()
    Columns("J:N").EntireColumn.Delete
    Columns("H").EntireColumn.Delete

End Sub

Sub Concat()
    iRow = 2
    Do
        Cells(iRow, 9) = Cells(iRow, 7) & " " & Cells(iRow, 8)
        iRow = iRow + 1
    Loop Until IsEmpty(Cells(iRow, 1))
End Sub

Sub AddProductHeader ()
    Cells(1,9).Value2 = "'product_total"
End Sub

Sub DeleteProductColumns ()
    Columns("G:H").EntireColumn.Delete
End Sub

Answer 1

Это должно работать:

Sub mergeproducts()
    Dim a As Application
    Set a = Application
    Dim wks As Worksheet
    Set wks = ActiveSheet
    wks.Application.ScreenUpdating = False
    max_col = 6
    Last = Cells(Rows.Count, "A").End(xlUp).Row
    For i = Last To 2 Step -1
        row_b = Join(a.Transpose(a.Transpose(wks.Range(Cells(i, 1), Cells(i, max_col)))), Chr(0))
        For j = i - 1 To 1 Step -1
            row_a = Join(a.Transpose(a.Transpose(wks.Range(Cells(j, 1), Cells(j, max_col)))), Chr(0))
            If row_a = row_b Then
                k = max_col + 1
                full = True
                    While full
                        If wks.Cells(i, k) = "" Then
                            wks.Cells(i, k) = wks.Cells(j, max_col + 1)
                            full = False
                        Else
                            k = k + 1
                        End If
                    Wend
                wks.Rows(j).Delete
                j = 1
            End If
        Next j
    Next i
    wks.Application.ScreenUpdating = True
    Final = MsgBox("Finished", vbInformation)
End Sub