用户输入1时开始的90天总和

Question

堆垛机，

所以我有这个电子表格，看起来像这样......

我想创建某种宏，它会查看值1或2，并在“90天内的＃”列中开始求和90天，从中输入值1或2。

我可能会做什么，或者我一直在做这个我已经做过的事情。 - ＆GT; =sum(xxxx:xxxx)

感谢您的帮助。

Answer 1

好的，所以这里是我的刺...它可能有点过头了，但弄清楚它很有趣，所以我想我会分享。我把它作为一个UDF（用户定义的函数），所以你应该将它放在一个单独的模块中（如果你把它放在其中一个工作表的代码中它将无法工作）。

你可以像使用它一样：

=Sum90Days(E2:DA2)

其中range参数包含整个网格。所以在我的例子中，可能的范围是E2到DA2。第一个数据点可能位于单元格J2中，因此该函数将在以后从J2到90个单元格求和。

无论如何，它非常直接，您应该能够修改以适应。只需将公式放在第一个“＃In 90 Days”单元格中并复制下来。

Function Sum90Days(possibleRange As Range)

    Dim firstValue As Variant

    firstValue = possibleRange.Find("*", After:=possibleRange.Columns(possibleRange.Columns.Count), SearchOrder:=xlByColumns, LookIn:=xlValues, SearchDirection:=xlNext).Column

    Sum90Days = Application.Sum(Range(Cells(possibleRange.Row, firstValue), Cells(possibleRange.Row, firstValue + 90)))

End Function

让我知道它是否会让你接近，或者如果你遇到任何问题......

修改 的

所以我发现你的桌子后面可能有数据，你可能不希望在总结中包含这些数据。这将找到起点，然后检查终点是否在表格之外。如果是，那么它只包括到表的末尾，否则它从起始值到起始值+ 90：

Function Sum90Days(possibleRange As Range)

    Dim firstValue As Variant
    Dim lastValue As Variant

    firstValue = possibleRange.Find("*", After:=possibleRange.Columns(possibleRange.Columns.Count), SearchOrder:=xlByColumns, LookIn:=xlValues, SearchDirection:=xlNext).Column
    lastValue = Application.Min(firstValue + 90, possibleRange.Columns.Count)
    Sum90Days = Application.Sum(Range(Cells(possibleRange.Row, firstValue), Cells(possibleRange.Row, firstValue + 90)))

End Function

编辑＃2

好的，按照下面的要求是一个做同样事情的宏。您通常以相同的方式使用它，您必须放入构成求和区域的列。例如，像这样调用宏将迭代表范围并仅填充适当的值：

Sub test()
    Call Sum90DaysMacro(Range("F14:DA50000"))
End Sub

即使你传入一个巨大的部分，宏也会在表中找到你传递给它的第一个和最后一个使用的值，只是遍历使用过的部分。

注意第一行值是表的开头（在本例中为14）。最后一行可能是一些荒谬的大值，如50k）。我这样做的原因是因为我不知道桌子从上面的截图开始。这将为您提供足够的灵活性，并节省了一些时间来确定表的开始位置和结束位置。可能有更好的方法，但你得到的是你付出的......

倒数第二位......确保复制宏和两个辅助函数First和Last。

最后一点......虽然我可以添加着色部分，但我想我会留下一些东西给你试试。这并不难，你应该能够通过谷歌搜索和宏观录音的组合来解决它。如果你遇到困难，请发布你试过的内容，我会让你朝着正确的方向前进。

祝你好运！

Sub Sum90DaysMacro(tableRange As Range)
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

    Dim firstValue As Variant
    Dim lastValue As Variant
    Dim firstRow As Long
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim firstColumn As Long
    Dim i As Long

    lastColumn = Last(2, tableRange)
    lastRow = Last(1, tableRange)

    firstColumn = First(2, tableRange)
    firstRow = First(1, tableRange)


     For i = firstRow To lastRow
    firstValue = Application.Max(firstColumn, First(2, Range(Cells(i, firstColumn), Cells(i, lastColumn))))
    lastValue = Application.Min(firstValue + 90, lastColumn)
    Cells(i, firstColumn - 1).Value = Application.Sum(Range(Cells(i, firstValue), Cells(i, firstValue + 90)))
Next i

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Function Last(choice As Long, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
' 3 = last cell
    Dim lrw As Long
    Dim lcol As Long

    Select Case choice

    Case 1:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

    Case 3:
        On Error Resume Next
        lrw = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        lcol = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
        If Err.Number > 0 Then
            Last = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0

    End Select
End Function

Function First(choice As Long, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
' 3 = last cell
    Dim lrw As Long
    Dim lcol As Long

    Select Case choice

    Case 1:
        On Error Resume Next
        First = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        First = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False).Column
        On Error GoTo 0

    Case 3:
        On Error Resume Next
        lrw = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlNext, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        lcol = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        First = rng.Parent.Cells(lrw, lcol).Address(False, False)
        If Err.Number > 0 Then
            First = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0

    End Select
End Function