Question

我正在创建一个摘要宏，我需要将C列和D列的所有值加到E中的合并单元格中。在所附的图像中，总和已放置以显示我想要的结果。我已经有代码根据A中的名称合并E列中的单元格。IE总结所有过期和重要的鲍勃和放置在合并列中，然后昵称。这是我所需要的，只是求助：

Sub MergeSameCell()

    Dim Rng As Range, xCell As Range
    Dim xRows As Integer

    Set WorkRng = ThisWorkbook.Worksheets("Summary").Range("A:A")

    lastRow = ActiveSheet.Columns("A").Cells.Find("*", SearchOrder:=xlByRows,
    LookIn:=xlValues, SearchDirection:=xlPrevious).Row

    xRows = lastRow
    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
                End If
            Next
            WorkRng.Parent.Range(Rng.Cells(i, 5), Rng.Cells(j - 1, 5)).Merge
            i = j - 1
        Next
    Next

End Sub

Answer 1

以下内容专门使用了您随附的数据，并假设该数据已经按A列进行了排序，并且E列中的单元格已经合并。

Public Sub GroupSum()
Dim i0 As Long, i1 As Long, strName As String
With ActiveSheet
    For i0 = 2 To .UsedRange.Rows.Count
        If Not .Cells(i0, 1).Value = strName Then
            strName = .Cells(i0, 1)
            i1 = i0
        End If
        .Cells(i1, 5).Value = .Cells(i0, 3).Value + .Cells(i0, 4).Value + .Cells(i1, 5).Value
    Next i0
End With
End Sub

Answer 2

我将合并单元格的对齐格式留给您。

Option Explicit

Sub MergeSameCell()

    Dim clientRng As Range
    Dim lastRow As Long, lastClientRow As Long

    With ThisWorkbook.Worksheets("Summary")

        .Columns(5).UnMerge

        Set clientRng = .Range("A2")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        Do
            lastClientRow = .Columns(1).Find(what:=clientRng.Value, after:=clientRng, _
                                             lookat:=xlWhole, SearchDirection:=xlPrevious).Row
            With clientRng.Offset(0, 4)
                .Resize(lastClientRow - clientRng.Row + 1, 1).Merge
                .Formula = "=sumifs(c:c, a:a, " & Chr(34) & clientRng.Value2 & Chr(34) & ")+" & _
                            "sumifs(d:d, a:a, " & Chr(34) & clientRng.Value2 & Chr(34) & ")"
                'optionally revert the formulas to their returned value
                'value = .value2
            End With

            Set clientRng = clientRng.Offset(lastClientRow - clientRng.Row + 1, 0)

        Loop While clientRng.Row <= lastRow

    End With

End Sub

Answer 3

这消除了几个循环：

Sub MergeSameCell()

    With ThisWorkbook.Worksheets("Summary")
        Dim i as Long
        For i = 2 To .Rows.Count
            If .Cells(i, 1) = "" Then Exit Sub
            Dim x As Long
            x = .Evaluate("MATCH(TRUE," & .Cells(i, 1).Address & "<>" & .Range(.Cells(i, 1), .Cells(.Rows.Count, 1)).Address & ",0) - 2 + " & i)
            .Cells(i, 5).Value = Application.Sum(.Range(.Cells(i, 3), .Cells(x, 4)))
            .Range(.Cells(i, 5), .Cells(x, 5)).Merge
            i = x
        Next i
    End With

End Sub

如何将两个相邻列的总和放入一个合并的单元格（VBA）中？

3 个答案: