In the worksheet, column A is the data to be processed, column c is the separation point, column d is the data interval, column e is the data frequency, column f is the data frequency, and column g is the data frequency divided by the group distance,This code adapts to each column of data containing the header.


The header name of the worksheet c list is the separation point, the name of the d list header is the interval, the name of the e list header is the frequency, the name of the f list header is the frequency, and the name of the g list header is the frequency divided by the group distance.


the excel file:
cplans.xlsm


the code is as follows:
the first question is:How to optimize this running code.







Option Explicit



Sub maxmin()
Dim xU As Range, vMin, vMax, MinADS$, MaxADS$
Dim p, q, groupsp, drow
Set xU = ActiveSheet.Columns("a")
vMin = Application.Min(xU)
vMax = Application.Max(xU)
MinADS = xU.Find(vMin, Lookat:=xlWhole).Address(0, 0)
'MaxADS = xU.Find(vMax, Lookat:=xlWhole).Address(0, 0)
'MsgBox MinADS & " " & CDec(vMin) & vbCrLf & MaxADS & " " & CDec(vMax)
[b1] = "Min"
[b2] = vMin
[b3] = "Max"
[b4] = vMax
[b5] = "gap"
[b6] = vMax - vMin
[b7] = "gropspace"
[b9] = "gropno"
p = ActiveSheet.Cells.Rows.Count
q = ActiveSheet.Cells(p, 3).End(xlUp).Row
If q >= 2 Then
groupsp = Cells(q, 3) - Cells(q - 1, 3)
[b8] = groupsp
Else
groupsp = [b8].Value
End If
'Range("c3:C" & q).Clear
If q <= 1 And [b8].Value = "" Then Exit Sub
If [c1].Value = "" And [b8].Value <> "" Then Exit Sub
For drow = q + 1 To ActiveSheet.Cells.Rows.Count
Cells(drow, 3) = Cells(drow - 1, 3) + groupsp
If Cells(drow, 3) = vMax Then Exit For
If Cells(drow, 3) > vMax Then Exit For
Next drow

'MsgBox groupsp
[b10] = ActiveSheet.Cells(p, 3).End(xlUp).Row - 1
End Sub


Sub histogram()
Dim p, q, t, i, n, d, j, m, r, s, x, l
Dim arr, brr, title
Columns("D:G").ClearContents
'Locate the number of rows in which the last row of data
'in the reference column is located.
p = ActiveSheet.Cells.Rows.Count
q = ActiveSheet.Cells(p, 3).End(xlUp).Row
'Set the maximum area where the data is located to an array.
'A is listed as the column in which the data source is located which name is arr.
'brr where the data is located to an array.
arr = Range("A1").CurrentRegion
brr = ActiveSheet.Range("c1:g" & q)
Range("d1:g" & UBound(brr)).ClearContents
'the no.of the data and the space
n = UBound(arr) - LBound(arr) + 1
d = brr(3, 1) - brr(2, 1)
'title is the header of the colum
title = Array("Group", "Frequency", "Frequency", "Frequency/group space")
'write the header of the data area
i = 0
For t = LBound(brr, 2) + 1 To UBound(brr, 2)
brr(1, t) = title(i)
i = i + 1
Next t
'Process the data in column c of the worksheet
'and generate interval data in column d
'Build data grouping intervals.
brr(2, 2) = "[" & 0 & "," & brr(1, 1) & ")"
For i = LBound(brr) + 1 To UBound(brr)
If IsNumeric(brr(i - 1, 1)) Then brr(i, 2) = "[" & brr(i - 1, 1) & "," & brr(i, 1) & ")"
Next i
'process the data in column a and produce the frequency
For j = 2 To UBound(brr)
brr(j, 3) = 0
For m = 1 To UBound(arr)
'If arr(m, 1) >= brr(j, 1) And arr(m, 1) < brr(j - 1, 1) Then brr(j, 3) = 0
If arr(m, 1) < brr(j, 1) And arr(m, 1) >= brr(j - 1, 1) Then brr(j, 3) = brr(j, 3) + 1
If Not IsNumeric(brr(j - 1, 1)) And arr(m, 1) < brr(j, 1) And arr(m, 1) >= 0 Then brr(j, 3) = brr(j, 3) + 1
Next
brr(j, 4) = brr(j, 3) / n
brr(j, 5) = brr(j, 4) / d
Next
ActiveSheet.Range("c1:g" & q) = brr
'sum of the data
x = UBound(brr) + 1
Cells(x, 4) = "Total"
'add the number
For r = LBound(brr, 2) + 2 To UBound(brr, 2)
For l = LBound(brr) + 1 To UBound(brr)
Cells(x, r + 2) = Cells(x, r + 2) + brr(l, r)
Next l
Next r
End Sub