Question

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

在起点的右侧移动一列，复制单元格的值，然后基本上在相邻的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

您应确定要处理的范围，然后在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

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

其余代码可按上述方式构建。

Answer 2

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

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

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

年度到每月宏

2 个答案: