单独合并选择中的变量行

Question

我有一个 Excel 2007 表格，如下所示：

    /|    A    |    B     |    C     |    D
    -+---------+----------+----------+----------+
    1| Item1   |  Info a  |  1200    | sum(C1:C2) 
    2|         |          |  2130    |          
    3| Item2   |  Info b  |  2100    | sum(C3:C7)
    5|         |          |  11      |          
    6|         |          |  12121   |          
    7|         |          |  123     |          
    8| Item3   |  Info c  |  213     | sum(C8:C10) 
    9|         |          |  233     |          
   10|         |          |  111     |          

我希望做的是，每当我选择整个表格（上例中的 A1:C10）并按 +，宏代码将自动将空白单元格与其上方包含文本的单元格合并，例如A1到A2； A3 到 A7 等等。 B 列也是如此。对于D列，合并后，它还会对C列中的所有项目进行求和。我可以手动进行合并和求和，但这会花费我相当长的时间，所以我一直在研究宏以使生活更轻松。

我想强调的是，每个项目上要合并的行数是可变的（Item 1 只有 2 行 - A1 和 A2， Item 2 有 4 个，依此类推。）

这可以在 Excel VBA 中实现吗？非常感谢任何帮助和评论。

Answer 1

如果您有大量行，请避免循环单元格本身，因为这非常慢。首先将单元格值复制到 Variant 数组中。

Option Explicit

Sub zx()
    Dim rngTable As Range
    Dim vSrcData As Variant
    Dim vDestData As Variant
    Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long

    Set rngTable = Range("A1:D10")

    vSrcData = rngTable
    ' vSrcData is now a two dimensional array of Variants

    ' set vDestData to an array of the right size to contain results
    ReDim vDestData(1 To WorksheetFunction.CountA(rngTable.Columns(1)), _
                    1 To UBound(vSrcData, 2))

    ' keep track of row in Destination Data to store next result
    i3 = LBound(vSrcData, 1)

    ' loop through the Source data
    For i1 = 1 To UBound(vSrcData, 1) - 1
        ' sum the rows with blanks in clumn A
        If vSrcData(i1, 1) <> "" Then
            For i2 = i1 + 1 To UBound(vSrcData, 1)
                If vSrcData(i2, 1) = "" Then
                    vSrcData(i1, 3) = vSrcData(i1, 3) + vSrcData(i2, 3)
                Else
                    Exit For
                End If
            Next
            ' copy the result to Destination array
            For i4 = 1 To UBound(vSrcData, 2)
                vDestData(i3, i4) = vSrcData(i1, i4)
            Next
            i3 = i3 + 1
        End If
    Next

    ' delete original data
    rngTable.ClearContents

    ' Adjust range to the size of results array
    Set rngTable = rngTable.Cells(1, 1).Resize(UBound(vDestData, 1), _
                                               UBound(vDestData, 2))

    ' put results in sheet
    rngTable = vDestData
End Sub

从 Excel、工具/宏菜单、选项设置快捷键