Простая гистограмма в VBA?

Question

У меня есть данные, хранящиеся в некотором столбце (скажем, столбец A). Длина столбца A не является фиксированной (зависит от предыдущих шагов в коде).

Мне нужна гистограмма для значений в столбце A, и она находится на том же листе. Мне нужно взять значения в столбце A и автоматически вычислить M Bins, а затем дать график.

Я искал в Интернете «простой» код, но все коды действительно причудливые, с тоннами деталей, которые мне не нужны, в той степени, в которой я даже не могу их использовать. (Я начинающий VBA.)

Я нашел следующий код, который, кажется, выполняет эту работу, но у меня возникают проблемы даже с вызовом функции. Кроме того, он только выполняет вычисления, но не составляет сюжет.

Sub Hist(M As Long, arr() As Single)
Dim i As Long, j As Long
Dim Length As Single
ReDim breaks(M) As Single
ReDim freq(M) As Single

For i = 1 To M
    freq(i) = 0
Next i

Length = (arr(UBound(arr)) - arr(1)) / M

For i = 1 To M
    breaks(i) = arr(1) + Length * i
Next i

For i = 1 To UBound(arr)
    If (arr(i) <= breaks(1)) Then freq(1) = freq(1) + 1
    If (arr(i) >= breaks(M - 1)) Then freq(M) = freq(M) + 1
    For j = 2 To M - 1
        If (arr(i) > breaks(j - 1) And arr(i) <= breaks(j)) Then freq(j) = freq(j) + 1
    Next j
Next i

For i = 1 To M
    Cells(i, 1) = breaks(i)
    Cells(i, 2) = freq(i)
Next i
End Sub

А потом я пытаюсь назвать это просто:

Sub TestTrial()
Dim arr() As Variant
Dim M As Double
Dim N As Range

arr = Range("A1:A10").Value
M = 10

Hist(M, arr)    ' This does not work.  Gives me Error (= Expected)
End Sub

Answer 1

Немного поздно, но все же я хочу поделиться своим решением. Я создал функцию Histogram, которую можно использовать как формула массива в таблице Excel. Примечание: вы должны нажать CTRL+SHIFT+ENTER для ввода формулы в рабочую книгу. Ввод - это диапазон значений и количество M бинов для гистограммы. Выходной диапазон должен содержать M строк и два столбца. Один столбец для значения бина и один столбец для частоты бина.

Option Explicit
Option Base 1

Public Function Histogram(arr As Range, M As Long) As Variant
On Error GoTo ErrHandler
    Dim val() As Variant
    val = arr.Value
    Dim i As Long, j As Integer
    Dim Length As Single
    ReDim breaks(M) As Single
    ReDim freq(M) As Integer

    Dim min As Single
    min = WorksheetFunction.min(val)
    Dim max As Single
    max = WorksheetFunction.max(val)

    Length = (max - min) / M

    For i = 1 To M
        breaks(i) = min + Length * i
        freq(i) = 0
    Next i

    For i = 1 To UBound(val)
        If IsNumeric(val(i, 1)) And Not IsEmpty(val(i, 1)) Then
            If val(i, 1) > breaks(M) Then
                freq(M) = freq(M) + 1
            Else
                j = Int((val(i, 1) - min) / Length) + 1
                freq(j) = freq(j) + 1
            End If
        End If
    Next i

    Dim res() As Variant
    ReDim res(M, 2)
    For i = 1 To M
        res(i, 1) = breaks(i)
        res(i, 2) = freq(i)
    Next i

    Histogram = res
ErrHandler:
    'Debug.Print Err.Description
End Function

Answer 2

Не уверен на 100% в эффективности этого подхода, но;

• Удалите символы, когда вы называете субмарину;Hist M, arr
• M объявлен как double, но получен функцией как long;это не сработает, поэтому объявите его в вызывающей подпрограмме как long
• Вам потребуется получить arr() As Variant
• Range -> Array, создающий 2-мерный массив, поэтому элементы arr(1, 1) .. arr(n, 1)