Поиск самых высоких 12 непрерывных значений в диапазоне

Question

У меня есть данные, распределенные по строкам и столбцам, и я хотел бы найти диапазон из 12 ячеек рядом с каждым с самым высоким значением. Где рядом друг с другом означает слева направо, а затем, начиная с следующего ряда. т.е. A5, B5, ..., L5, A6, B6, ...

Я мог бы указать все возможные диапазоны т.е. A5:L5, B5:A6... сумму и сравнить, но это не кажется, как очень эффективный способ идти о вещах.

Как это сделать?

Answer 1

дайте это попробовать. Вы просто выделяете диапазон, и поле сообщения возвращает начальную позицию целочисленного массива 12.

Sub test() 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

    Dim rng As Range 

    Dim FC As Integer 
    Dim LC As Integer 
    Dim FR As Integer 
    Dim LR As Integer 

    Dim r As Integer 
    Dim c As Integer 
    Dim i As Integer 
    Dim j As Integer 
    Dim k As Integer 
    Dim max As Integer 
    Dim maxI As Integer 
    Dim maxCol As Integer 
    Dim maxRow As Integer 

    Dim intArray() As Integer 

    Set rng = Selection 

    FC = rng.Column 
    FR = rng.Row 
    LC = FC + rng.Columns.Count - 1 
    LR = FR + rng.Rows.Count - 1 

    ReDim intArray(1 To (LC * LR)) 

    i = 1 

    For r = FR To LR 
     For c = FC To LC 
     intArray(i) = Cells(r, c) 
     i = i + 1 
     Next c 
    Next r 

    max = 0 

    For i = 1 To (UBound(intArray) - 11) 
     k = 0 
     k = intArray(i) 
     For j = 1 To 11 
      k = k + intArray(i + j) 
     Next j 
     If k > max Then 
      max = k 
      maxI = i 
     End If 
    Next i 

    maxCol = maxI Mod (rng.Columns.Count) 
    maxRow = ((maxI - maxCol)/rng.Columns.Count) + 1 

    MsgBox ("Max array begins in row " & maxRow & " column " & maxCol) 


Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

End Sub 

Позвольте мне знать, если это не так