Question

感谢一些好人在这个论坛，我已经能够使用以下宏来获取我需要的东西：

Public Sub main()
    'declaration
    Dim rng As Range
    Const SourceRange = "H"
    Dim NumRange As Range, formulaCell As Range
    Dim SumAddr As String
    Dim c As Long

    'Loop trough all rows
    Set rng = Range("H2")
    While rng.Value <> ""
        rng.Offset(20).Resize(1).EntireRow.Insert
        Set rng = rng.Offset(21)
    Wend

   'Fill the Blank Rows in A
   Columns("A:A").Select
   Selection.SpecialCells(xlCellTypeBlanks).Select
   Selection.FormulaR1C1 = "=R[-1]C"


   For Each NumRange In Columns(SourceRange).SpecialCells(xlConstants, xlNumbers).Areas
       SumAddr = NumRange.Address(False, False)
       Set formulaCell = NumRange.Offset(NumRange.Count, 0).Resize(1, 1)
       formulaCell.Formula = "=SUM(" & SumAddr & ")"

       'change formatting to your liking:
       formulaCell.Font.Bold = True
       formulaCell.Font.Color = RGB(255, 0, 0)

       c = NumRange.Count
   Next NumRange

End Sub

简而言之，这会在第20行创建一行，从列中的单元格中取出数字＆＃34; A＆＃34;在空白行中并总结列中的第20个单元格＆＃34; H＆＃34;得出总成绩＆＃34;在空行。

我还有一个关于这个宏的问题。

在运行上面的宏之后，＆＃34; Sum＆＃34;在添加的新行中放置20行和20行。理想情况下，我想删除已经累加的所有20行，只剩下添加的行。这个问题是前一个宏的最后一部分对给定数量的单元格进行求和，如果我删除行，则求和将是错误的（以及A列中上面单元格中的数字）。

有没有办法向宏添加内容，以便删除20和行而不影响A列中前一个单元格的求和和数字？

它看起来像这样：删除行2-21，跳过第22行，删除第23-42行，跳过第43行，删除第44-63行，跳过第64行等等。

据我所知，这可能意味着必须更改之前发布的宏，但我认为值得一提。

先谢谢你们。

Best，Helge

Answer 1

你走了：

Public Sub main()
    'declaration
    Dim rng As Range
    Const SourceRange = "H"
    Dim NumRange As Range, formulaCell As Range
    Dim SumAddr As String
    Dim c As Long
    Dim iFirstRow As Integer, iLastCell As Integer


    'Loop trough all rows in H column
    Set rng = Range(SourceRange & "2")
    While rng.Value <> ""
        rng.Offset(20).Resize(1).EntireRow.Insert
        With rng.Offset(20)
            .Formula = "=sum(" & SourceRange & rng.Row & ":" & SourceRange & rng.Offset(19).Row & ")"
            .Formula = .Value2

           'change formatting to your liking:
            .Font.Bold = True
            .Font.Color = RGB(255, 0, 0)

            'set next group start
            Set rng = rng.Offset(21)

            'delete rows
            iFirstRow = .Column - 1
            With Range(.Offset(-20, -iFirstRow), .Offset(-1, -iFirstRow))

                iLastCell = .Cells(.Rows.Count, "A").End(xlUp).Row

                'Fill the Blank Rows in A
                With Cells(rng.Offset(-1).Row, 1)
                    .Formula = "=" & Cells(iLastCell, 1).Address
                    .Formula = .Value2
                End With

                'Delete group rows
                .EntireRow.Delete
            End With

        End With
    Wend
End Sub

使用VBA

1 个答案: