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用于上述示例）并按<Ctrl> + <M>时，宏代码会自动将空白单元格与其上方的单元格合并包含文本，例如A1至A2; A3到A7等等。第B列也是如此。对于列D，在合并之后，它还会汇总列C中的所有项目。我可以手动进行合并和求和，但这需要我一段时间，所以我一直在寻找宏来让生活更轻松。

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

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

Answer 1

如果您有大量行，请避免循环遍历单元格，因为这非常慢。 Instaed首先将单元格值复制到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，工具/宏菜单，选项

设置快捷键

单独合并选择中的变量行

1 个答案: