Выбор непрерывно заполненных ячеек и расчет MAX, MIN, AVG

Изображение 48466 Надеюсь, вы все в безопасности. Я пытаюсь вычислить значения MAX, MIN и AVG заполненных ячеек, которые продолжаются без пустой ячейки (как вы можете видеть это в левой части образца изображения). Я столкнулся с проблемой выбора этих случайно расположенных ячеек и вычисления вышеуказанных значений, а также значений «От» и «До» соответствующего диапазона. Пожалуйста, дайте мне знать, как это сделать. До сих пор я создал следующий код

    Dim Cel As Range
    Dim lastrow As Long
    Dim destSht As Worksheet

    Set destSht = Worksheets("Final")

   With Worksheets("Source")   
   lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
   For Each Cel In .Range("C2:C" & lastrow)
   If .Cells(Cel.Row, "C") <> "" Then
    Cel.Offset(0, -1).Copy Destination:=destSht.Cells(destSht.Rows.Count, 1).End(xlUp).Offset(0, 1)    
   'It will give "From" Column

   '' Plz suggest for "To" Column

   Range("G5").Select
   ActiveCell.FormulaR1C1 = "=MAX(RC[-4]:R[4]C[-4])"    'It will give values "MAX" Column
   Range("H5").Select
   ActiveCell.FormulaR1C1 = "=MIN(RC[-5]:R[4]C[-5])"    'It will give values "MIN" Column
   Range("I5").Select
   ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-6]:R[4]C[-6])"  'It will give values "AVG" Column

   End If
   Next
# excel
Источник
Codelisting
за 1 против
Лучший ответ

Сделал несколько быстрых, которые должны сработать. Я не знаю, что вы хотите сделать на «Заключительном» листе, поэтому не сосредотачиваюсь на этой строке.

Логика состоит в том, чтобы иметь один большой цикл (For i... ), которые проходят через весь столбец C. Когда значение находится в столбце C (If .Cells(i, "C") <> "" Then ) выполняем «малую петлю» (For j = i To lastrow + 1 ), чтобы проверить следующую пустую ячейку, чтобы определить диапазон «малой группы». Когда этот диапазон определен, мы выполняемTo ,From ,MAX ,MIN а такжеAVG формулы, которые должны быть динамическими.

Option Explicit

Sub trial()

Dim lastrow As Long
Dim destSht As Worksheet
Dim i As Long, j As Long


Set destSht = Worksheets("Final")

With Worksheets("Source")
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row

    For i = 2 To lastrow + 1 'loop whole range (column C)
        If .Cells(i, "C") <> "" Then 'If column C is not empty then
            For j = i To lastrow + 1 'Loop "group" range to find next empty cell. Start from current loop i to last row and add one row to get to next empty cell.
                If .Cells(j, "C") = "" Then 'When next empty cell is found (i.e. end of small group range) then apply formulas
                    .Cells(i, "E").Value = .Cells(i, "B").Value 'From
                    .Cells(i, "F").Value = .Cells(j - 1, "B").Value 'To
                    .Cells(i, "G").Formula = "=MAX(C" & i & ":C" & j - 1 & ")" 'MAX
                    .Cells(i, "H").Formula = "=MIN(C" & i & ":C" & j - 1 & ")" 'MIN
                    .Cells(i, "I").Formula = "=AVERAGE(C" & i & ":C" & j - 1 & ")" 'AVG
                    Exit For
                End If
            Next j
        End If
    Next i

End With

End Sub

Результат:

Изображение 306363

  • 0
    Большое спасибо @Wizhi ... Это работает как шарм ... Не могли бы вы сообщить мне, как пропустить после получения результата только в первой строке (как вы можете видеть это в левой части образца изображения в желтый цвет) .... В основном мне не нужны значения после получения первой строки каждого диапазона
  • 0
    Получил ответ через другое сообщение .... Заменено ... If .Cells (i, "C") <> "" ... на ... If .Cells (i, "C") <> "" And .Cells (i - 1, "C") = "" ........... Еще раз спасибо @Wizhi
  • 1
    Рад, что это немного помогло. Вы ответили быстрее, но да, это простое и хорошее решение, если вам нужна только первая строка. Удачного кодирования :).
Codelisting
Популярные категории
На заметку программисту