Question

我正在创建一个自动应计模板。它有以下要求：

数据必须先按帐户排序，然后按业务部门排序。必须为两个组的每个业务单位插入抵消行：带有帐户的行＆＃34; 101＆＃34;和所有其他帐号的行。
抵消行应反映上述适当的业务单位。
抵消行的帐号应为＆＃34; 750＆＃34;如果是＆＃34; 101＆＃34;小组，它应该是＆＃34; 780＆＃34;如果是所有其他帐户组。
交易类型应始终为＆＃34; 25＆＃34;对于抵消线。
抵消行上的金额应该是上述组的负小计，这意味着它应该＆＃34;归零＆＃34;以上几行。

我的代码目前按帐户排序数据，然后按业务部门排序。它正确地插入业务单位。它也正确插入＆＃34; 25＆＃34;对于抵消行上的交易类型。它没有做的是说＆＃34;如果上面的行是101然后750或者如果上面的行不等于101然后是780.它也无法为上面的组创建负小计。

如果您希望查看最终结果，请查看最终结果标签。

我已发布文件here。

Sub accrualMacro()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'CLEAR ALL FILTERS
With ActiveSheet
.AutoFilterMode = False
End With

'FILTER AND SORT
Rows("10:10").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("ACCRUAL TEMPLATE").AutoFilter.Sort.SortFields. _
    Clear
ActiveWorkbook.Worksheets("ACCRUAL TEMPLATE").AutoFilter.Sort.SortFields. _
    Add Key:=Range("B10"), SortOn:=xlSortOnValues, Order:=xlAscending, _
    DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ACCRUAL TEMPLATE").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
ActiveWorkbook.Worksheets("ACCRUAL TEMPLATE").AutoFilter.Sort.SortFields. _
    Clear
ActiveWorkbook.Worksheets("ACCRUAL TEMPLATE").AutoFilter.Sort.SortFields. _
    Add Key:=Range("A10"), SortOn:=xlSortOnValues, Order:=xlAscending, _
    DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ACCRUAL TEMPLATE").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply

With Range("A10", Range("A" & Rows.Count).End(xlUp))
    .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    .Offset(2, -1).SpecialCells(xlCellTypeConstants).Offset(,     1).ClearContents
    .Offset(, -1).EntireColumn.Delete
    .EntireColumn.RemoveSubtotal
End With

End With

'INSERT BLANK ROWS AT
Dim Col As Variant
Dim BlankRows As Long
Dim lastRow As Long
Dim R As Long
Dim StartRow As Long

    Col = "B"
    StartRow = 10
    BlankRows = 1

    lastRow = Cells(Rows.Count, Col).End(xlUp).Row

With ActiveSheet
For R = lastRow To StartRow + 1 Step -1
If .Cells(R, Col) = "101" And .Cells(R + 1, Col) <> "101" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
End If
Next R
End With

'new method below
With ActiveSheet.Range("A10:A" & lastRow)
  Set myrange = .SpecialCells(xlCellTypeBlanks)
  If Not myrange Is Nothing Then
 myrange.FormulaR1C1 = "=R[-1]C"
 .Value = .Value
End If
End With

With ActiveSheet.Range("C10:C" & lastRow)
  Set myrange = .SpecialCells(xlCellTypeBlanks)
If Not myrange Is Nothing Then
 myrange.FormulaR1C1 = "25"
End If
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Answer 1

如果我理解正确，我不是百分百肯定。但在我看来，你正在寻找以下几行代码来完成你的宏：

Dim lngStartRow As Long
Dim lngEndRow As Long

lngStartRow = 11

For lngEndRow = 11 To Sheet1.Cells(Sheet1.Rows.Count, Col).End(xlUp).Row
    If Trim(Sheet1.Cells(lngEndRow, 4).Formula) = vbNullString Then
        Sheet1.Cells(lngEndRow, 4).Formula = "=-SUM(D" & lngStartRow & ":D" & lngEndRow - 1 & ")"
        lngStartRow = lngEndRow + 1
    End If
Next lngEndRow

基本上，For ... Next循环遍历行并检查空行（从第一行开始是11）。如果有一个空白行（在D列中），则所有上述单元格将使用SUM公式进行汇总。此外，下一个SUM的“新起点”将被设置为下一个可用行。正在重复该过程，直到列D中的所有行都已汇总（除了最后一个块）。如果您还希望包含最后一个块，则必须使用+1扩展循环。

使用Excel中的VBA创建应计模板

1 个答案: