年度到月度宏

Question

我正在尝试制作一个在 find 函数选择的一组单元格上运行的公式。从 Bdgt FY21 开始。该公式的目的是从年度转换为月度并添加一个总和公式；

在起点右侧移动一列，复制单元格值，然后在相邻的 12 列（每年到每月）中基本上输入该值的 12 分之一。然后公式需要将这些数字粘贴为值，跳回年度数字，将其删除，并替换为求和公式。注意我不能使用活动单元格，因为那不允许我在多个选定的单元格上运行代码

下面的代码（不是……是我为缩短帖子而遗漏的其他月份）。代码显然不起作用；

Sub A_MONTHLY()

    cell.Offset(0, 2)"=RC[-1]/12"
    cell.Offset(0, 2).NumberFormat = "#,##0_);(#,##0);"

    cell.Offset(0, 3) "=RC[-2]/12"
    cell.Offset(0, 3).NumberFormat = "#,##0_);(#,##0);"

    cell.Offset(0, 4) "=RC[-3]/12"
    cell.Offset(0, 4).NumberFormat = "#,##0_);(#,##0);"

    .......

    cell.Offset(0, 13) "=RC[-3]/12"
    cell.Offset(0, 13).NumberFormat = "#,##0_);(#,##0);"

    cell.Offset(0, 2).range("A1:L1").Select
    Selection.PasteSpecial Paste:=xlPasteValues

    cell.Offset(0, -1).range("A1").Select
    Application.CutCopyMode = False
    Selection.ClearContents

    cell.FormulaR1C1 = "=SUM(RC[1]:RC[12])"

End Sub

Answer 1

使用循环遍历所选区域的所有行：

Public Sub AnnualToMonthly()
    If Selection.Columns.Count > 1 Then Exit Sub

    Dim iCell As Range
    For Each iCell In Selection
        With iCell.Offset(ColumnOffset:=1).Resize(ColumnSize:=12)
            .Value = iCell.Value / 12
            .NumberFormat = "#,##0_);(#,##0);"
            iCell.FormulaR1C1 = "=SUM(RC[1]:RC[12])" 'Alternatively iCell.Formula = "=SUM(" & .Address(False, False) & ")"
        End With
    Next iCell
End Sub

只需在您的列TOTAL 中选择一个范围并运行它。

---

更快的替代方法是将数据读入数组，将所有值除以 12 并立即写回：

Public Sub AnnualToMonthly2()
    Dim SelRange As Range
    Set SelRange = Selection

    If SelRange.Columns.Count > 1 Then Exit Sub

    Dim ValArr As Variant
    ValArr = SelRange.Value 'read all values into array

    If SelRange.Rows.Count > 1 Then
        Dim i As Long
        For i = LBound(ValArr) To UBound(ValArr)
            ValArr(i, 1) = ValArr(i, 1) / 12 'divide all values by 12
        Next i
    Else
        ValArr = ValArr / 12
    End If

    'write divided values back (very fast)
    With SelRange.Offset(ColumnOffset:=1).Resize(ColumnSize:=12)
        .Value = ValArr
        .NumberFormat = "#,##0_);(#,##0);"
    End With

    'write formula for total sum
    SelRange.FormulaR1C1 = "=SUM(RC[1]:RC[12])"
End Sub

这样，您只有一个数据读取操作和一个数据写入操作。这应该比在循环中逐行写入要快。

Answer 2

您应该确定要处理的范围，而不是在 with 部分设置公式和格式。像这样：

Dim rng As Range
Set rng = ActiveWorkbook.Worksheets(1).Range("b1:b10")
'update "b1:b10" to your range in parentheses and update worksheets property if necessary

With rng
    .Offset(0, 2).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 2).FormulaR1C1 = "= R[0]C[-1]/12"
    .Offset(0, 3).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 3).FormulaR1C1 = "= R[0]C[-2]/12"
    .Offset(0, 4).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 4).FormulaR1C1 = "= R[0]C[-3]/12"
    .Offset(0, 5).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 5).FormulaR1C1 = "= R[0]C[-4]/12"
    .Offset(0, 6).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 6).FormulaR1C1 = "= R[0]C[-5]/12"
    .Offset(0, 7).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 7).FormulaR1C1 = "= R[0]C[-6]/12"
    .Offset(0, 8).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 8).FormulaR1C1 = "= R[0]C[-7]/12"
    .Offset(0, 9).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 9).FormulaR1C1 = "= R[0]C[-8]/12"
    .Offset(0, 10).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 10).FormulaR1C1 = "= R[0]C[-9]/12"
    .Offset(0, 11).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 11).FormulaR1C1 = "= R[0]C[-10]/12"
    .Offset(0, 12).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 12).FormulaR1C1 = "= R[0]C[-11]/12"
    .Offset(0, 13).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 13).FormulaR1C1 = "= R[0]C[-12]/12"
End With

我建议您更改顺序。首先设置单元格格式，然后输入其值。

其余的代码可以如上构建。