VBA：尋找連續數

Question

我有一個從A1到全部爲1（1000個值）變爲一個表中和的最大值，我必須找到例如連續編號的最大值，如果我有這六個值：

4 37 -12 2 3 -1，從前兩個數字開始，最大值爲41。如果它是

-6 -14 6 15 22 -9，它將是43（從6,15,22）。

我必須在隨機生成的數字中計算出VBA中的數據，但是無法計算出這部分，然後必須返回序列中第一個和最後一個值的位置。所以請一定幫助將不勝感激，因爲我不是一個VBA嚮導。

謝謝:)

Answer 1

考慮下面的例子：

Sub Test() 

    Dim arrValues() As Variant 
    Dim dblTop As Double 
    Dim lngFirst As Long 
    Dim lngLast As Long 
    Dim i As Long 
    Dim j As Long 
    Dim dblSum As Double 
    Dim arrResult() As Variant 

    arrValues = Range("A1:ALL1") 
    dblTop = arrValues(1, 1) 
    lngFirst = 1 
    lngLast = 1 

    For i = 1 To 1000 
     dblSum = 0 
     For j = i To 1000 
      dblSum = dblSum + arrValues(1, j) 
      If dblSum > dblTop Then 
       lngFirst = i 
       lngLast = j 
       dblTop = dblSum 
      End If 
     Next 
    Next 

    Debug.Print "Max value: " & dblTop 
    Debug.Print "First index: " & lngFirst 
    Debug.Print "Last index: " & lngLast 
    arrResult() = Array() 
    For k = lngFirst To lngLast 
     ReDim Preserve arrResult(UBound(arrResult) + 1) 
     arrResult(UBound(arrResult)) = arrValues(1, k) 
    Next 
    Debug.Print "Sequence: " & Join(arrResult, " + ") 

End Sub 

對於設定的值電子商務。 G。如問題

它返回下面的輸出

Answer 2

這將做到這一點：

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）的時間複雜度o更有效f另一個答案。

。

UPDATE

爲了處理所有負數的邊緣情況下，你可以使用這個版本：

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 

Answer 3

只要是有一點不同，因爲我所做的工作之前，我的週末炸燬了，這裏是一個將返回一個範圍內的功能：

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.It可以從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*)) 

要獲取範圍：

第一個單元格：

=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。