Режим расчета для переменного диапазона, установленного до цикла

Question

Я хочу рассчитать режим для диапазона. Диапазон - это переменная, основанная на условии.

Value 1     Value 2     Output
A           10          10
A           12          10
A           10          10
B           5           3
B           3           3
B           2           3
B           3           3

Как и в предыдущем случае:

Мне нужно вычислить режим (столбец C) с диапазоном значений 2 (столбец B). ), с условием, что значение 1 (столбец A) будет одинаковым в диапазоне.

Sub mode()

Dim count
Dim rng As Range

x = 2
Do While Range("A" & x).Value = Range("A" & x + 1).Value
     x = x + 1
Loop

Set rng = Range(Cells(x, 2), Cells(x + 1, 2))
md = WorksheetFunction.mode(rng)
Range("C" & x).Value = md

End Sub

Есть ли у вас какие-либо подсказки для этого?

Answer 1

Если ваши данные в формате A1: B7, поместите их в C1 и скопируйте вниз.

Это формула массива, поэтому ее необходимо подтвердить с помощью Ctrl, Shift и Enter, и вокруг фигурных скобок появятся круглые скобки. формула.

=MODE(IF($A$1:$A$7=A1,$B$1:$B$7))

Конечно, вы можете добавить формулу с помощью VBA.

Answer 2

Введите следующую формулу как формулу массива ( Ctrl + Shift + Введите ) в ячейку C1 и перетащите ее вниз

=MODE(IF(A:A=A1,B:B))

^{Примечание. В новых версиях Excel вам может понадобиться использовать функцию MODE.SNGL.}

^{Изображение 1: В столбце C используется формула массива с условием IF.}

Для получения дополнительной информации см. Условный режим с критериями .

Answer 3

Для справки, а не для лучшего ответа, ниже приведен VBA, которую я написал, которая выполняет ту же задачу, что и формула массива из других ответов:

Sub mode2()
Dim lastrow As Long, x As Long, b As Long
Dim cel As Range, cel2 As Range
Dim rng() As Variant
b = 2
lastrow = Range("A" & Rows.count).End(xlUp).Row
For Each cel In Range("A2:A" & lastrow)
    If cel.Value = cel.Offset(1, 0).Value Then
            If (Not Not rng) = 0 Then
                ReDim rng(0 To 0)
                rng(0) = cel.Offset(, 1).Value
            Else
                ReDim Preserve rng(0 To (cel.Row - b))
                rng(cel.Row - b) = cel.Offset(, 1).Value
        End If
    Else
        ReDim Preserve rng(0 To (cel.Row - b))
        rng(cel.Row - b) = cel.Offset(, 1).Value
        If (Not Not rng) <> 0 Then
            Range("C" & cel.Row).Value = Application.WorksheetFunction.mode(rng)
            b = cel.Row + 1
            Erase rng()
        End If
    End If
Next cel
End Sub

Это, вероятно, не самый чистый или лучший макрос,но это работает и, возможно, это поможет кому-то, когда формула не вариант. (по крайней мере для меня будет полезно, если я когда-нибудь пойду код боулинг )