Выбор непрерывно заполненных ячеек и расчет MAX, MIN, AVG - PullRequest
1 голос
/ 05 августа 2020

введите описание изображения здесь Надеюсь, вы все в безопасности. Я пытаюсь вычислить значения 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

1 Ответ

1 голос
/ 05 августа 2020

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

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

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

Результат:

введите описание изображения здесь

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...