VBA:查找连续数之和的最大值

时间:2015-11-15 17:53:51

标签: excel vba excel-vba

我有一张从A1到ALL1(1000个值)的表格,我必须找到连续数字的最大值,例如,如果我有这六个值:

4 37 -12 2 3 -1,最大值为前两个数字中的41。如果是

-6 -14 6 15 22 -9,它将是43(从6,15,22)。

我必须在VBA中从随机生成的数字中执行此操作(计算出部分因此它很好),但无法弄清楚这部分然后我必须返回序列中第一个和最后一个值的位置。所以请一些帮助将非常感谢,因为我不是一个VBA向导。

谢谢:)

3 个答案:

答案 0 :(得分:0)

考虑以下示例:

<article>
  <header>Mouse Over and Mouse Out Events</header>
  <img onmouseover="showImage(this)" onmouseout="hideImage()" src="https://static.pexels.com/photos/9413/animal-cute-kitten-cat-small.jpg" />
  <img onmouseover="showImage(this)" onmouseout="hideImage()" src="https://static.pexels.com/photos/13937/pexels-photo-13937-small.jpeg" />
  <img onmouseover="showImage(this)" onmouseout="hideImage()" src="https://static.pexels.com/photos/7517/animal-sitting-animals-inside-small.jpg" alt="Cat with bread on face 3" />
  <img onmouseover="showImage(this)" onmouseout="hideImage()" src="https://static.pexels.com/photos/254/pet-kitten-cat-lying-small.jpg" />
</article>
<article>
  <header>Cat Photos</header>
  <img id="full" />
</article>

对于值e的集合。 G。如问题

sheet1

返回以下输出

result

答案 1 :(得分:0)

这样做:

Sub msa()
    Dim j&, cur&, max&, ndx&, ndx1&, ndx2&, a: ndx = 1
    a = [A1:ALL1]
    For j = 1 To UBound(a, 2)
        cur = cur + a(1, j)
        Select Case True
            Case cur > max:  max = cur:  ndx2 = j:  ndx1 = ndx
            Case cur <= 0:   cur = 0:    ndx = j + 1
        End Select
    Next
    MsgBox max & vbLf & ndx1 & vbLf & ndx2
End Sub

我的答案基于Kadane's algorithm,其时间复杂度为O(n),这比其他答案的蛮力O(n * n)时间复杂度更有效。

<强>更新

要处理所有负数的边缘情况,您可以使用此版本:

Sub msa()
    Dim j&, k&, m&, n&, cur&, max&, ndx&, ndx1&, ndx2&, a: ndx = 1: m = -2 ^ 31
    a = [A1].CurrentRegion.Resize(1)
    For j = 1 To UBound(a, 2)
        k = a(1, j)
        If k > m Then m = k: n = j
        cur = cur + k
        Select Case True
            Case cur > max:  max = cur:  ndx2 = j:  ndx1 = ndx
            Case cur <= 0:   cur = 0:    ndx = j + 1
        End Select
    Next
    If max = 0 Then max = m: ndx1 = n: ndx2 = n
    MsgBox max & vbLf & ndx1 & vbLf & ndx2
End Sub

答案 2 :(得分:0)

只是有点不同,因为我在周末爆炸之前完成了工作,这里有一个函数会返回一个范围:

Function MAXSUM(r As Range) As Range
Dim i&, j&
Dim rng As Range
Dim sm As Double
Dim ws As Worksheet

Set ws = ActiveSheet
sm = r.Item(1) + r.Item(2)
For i = 1 To r.Cells.Count - 1
    For j = i + 1 To r.Cells.Count
        With ws
            If WorksheetFunction.Sum(.Range(r(i), r(j))) > sm Then
                Set rng = .Range(r(i), r(j))
                sm = WorksheetFunction.Sum(.Range(r(i), r(j)))
            End If
        End With
    Next j
Next i

Set MAXSUM = rng

美丽之处在于:

1.它返回最大总和的范围。

2.它不依赖于第一行,它可以是列,行或每个的倍数。它将从左到右,然后从上到下看范围。

3.可以从vba中调用和/或直接在工作表中调用UDF(见下文)

从vba致电:

Sub getmax()
Dim rng As Range
Dim ws As Worksheet

Set ws = ActiveSheet

Set rng = MAXSUM(ws.Range("A1 :AAL1"))

Debug.Print rng.Address 'gets the address of range
Debug.Print WorksheetFunction.Sum(rng) 'gets the sum of the range

End Sub

这只是展示了一些东西,但因为它返回了一个范围,所以可以对给定范围做任何事情。

直接从工作表中致电:

得到总和:

=SUM(MAXSUM(*YourRange*))

获取范围:

First Cell:

=ADDRESS(ROW(MAXSUM(*YourRange*)),COLUMN(MAXSUM(*YourRange*)))

最后一个单元格:

=ADDRESS(ROW(MAXSUM(*YourRange*))+ROWS(MAXSUM(*YourRange*))-1,COLUMN(MAXSUM(*YourRange*))+COLUMNS(MAXSUM(*YourRange*))-1)

完整地址:

=ADDRESS(ROW(MAXSUM(*YourRange*)),COLUMN(MAXSUM(*YourRange*)))&":"&ADDRESS(ROW(MAXSUM(*YourRange*))+ROWS(MAXSUM(*YourRange*))-1,COLUMN(MAXSUM(*YourRange*))+COLUMNS(MAXSUM(*YourRange*))-1)

基本上,公式MAXSUM(*YourRange*)的工作方式类似于命名区域,您可以使用命名范围执行任何操作。

一个注意事项:这当前假设用户想要至少两个数字的总和,因此如果整个范围是负数,或者只有一个连续的正数,它将返回给出最高总和的两个连续单元格的总和。为了使它在所有阴性或仅一个连续阳性细胞的情况下返回最高的一个细胞,然后从for循环的开头移除+1-1