Слияние переменных строк в выделении по отдельности

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, меню «Инструменты / Макросы», «Параметры»