Question

我是这个论坛的新手，所以请耐心等待。

我有一个CSV文件，我需要应用一些VBA模块才能获得我需要的信息。

简而言之，我有3个宏，它们一起到下面：

每隔20行创建一个新行
从上面的单元格中取出数字（A列），并用这个数字填充新行中的空白区域。
将新行前20行中H列中的数字相加，得到总分。只要出现新行（每20行），就会随后执行此操作。

是否可以在一个宏中获取这三个宏？这样可以更容易地传递给可能需要使用这些宏的其他人。

当前代码：

' Step 1
Sub Insert20_v2()
    Dim rng As Range

    Set rng = Range("H2")
    While rng.Value <> ""
        rng.Offset(20).Resize(1).EntireRow.Insert
        Set rng = rng.Offset(21)
    Wend
End Sub

' Step 2
Sub FillBlanks()
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"

End Sub

' Step 3
Sub AutoSum()
    Const SourceRange = "H"
    Dim NumRange As Range, formulaCell As Range
    Dim SumAddr As String
    Dim c As Long

    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

感谢您的帮助。最好，

黑尔格

Answer 1

您可以创建一个Sub来调用您创建的所有其他潜艇。

示例：

Sub DoAllTasks() Insert20_v2 FillBlanks AutoSum End Sub

然后你只需创建一个按钮并为其指定DoAllTasks或直接运行宏。

HTH;）

Answer 2

那不应该那么难。

Public Sub main()
        'deklaration
        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

VBA Excel - 以特定间隔删除行

2 个答案: