☰

如果行 AF 相同，则需要 VBA 代码来合并行

tag-icon • tag-icon microsoft-excel microsoft-excel-2007 vba
如果行 AF 相同，则需要 VBA 代码来合并行

我需要一个 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

答案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

相关内容