VBA 度数分布表を自動で作成(関数)

Function Bord(x() As Double) As Double()
Dim i As Integer
Dim a As Integer

Dim b() As Double
Dim m As Double
Dim n As Integer
Dim h As Integer
Dim c As Double
Dim x_len As Integer
Dim max As Double, min As Double
max = x(1)
min = x(1)
x_len = UBound(x)

For i = 1 To x_len
If max < x(i) Then
max = x(i)
End If

If min > x(i) Then
min = x(i)
End If
Next i

n = 0
a = 0
Do While a = 0
a = 1
For i = 1 To x_len
x(i) = x(i) * 10 ^ n
If x(i) <> Int(x(i)) Then
a = 0
End If
x(i) = x(i) / 10 ^ n
Next i
n = n + 1
Loop

m = 10 ^ (-n + 1)
h = Int(UBound(x) ^ 0.5 + 0.5)

c = (max - min) / h
c = c / m
c = Int(c)
c = c * m

ReDim b(h + 1 + 1 + Int(h * m))

b(1) = min - m / 2

For i = 2 To UBound(b)
b(i) = b(i - 1) + c
Next i

Bord = b

End Function

Function dosu(x() As Double) As Integer()
Dim i As Integer
Dim c As Integer
Dim dou() As Integer
Dim b() As Double

b = Bord(x())
ReDim dou(UBound(b) - 1)

For i = 1 To UBound(x)
c = Int*1 / (b(2) - b(1))) + 1
dou(c) = dou(c) + 1
Next i

dosu = dou
End Function

上記の二つの関数を利用する

Function dos_fig(x() As Double, k As Integer, l As Integer)
Dim i As Double
Dim sum As Integer
Dim b() As Double
Dim dos() As Integer

b = Bord(x())
dos = dosu(x())

Cells(k, l).Value = "No."
Cells(k, l + 1).Value = "区間下限"
Cells(k, l + 2).Value = "区間上限"
Cells(k, l + 3).Value = "度数"

For i = 1 To UBound(dos)
Cells(k + i, l).Value = i
Cells(k + i, l + 1).Value = b(i)
Cells(k + i, l + 2).Value = b(i + 1)
Cells(k + i, l + 3).Value = dos(i)
sum = sum + dos(i)
Next i

Cells(k + UBound(dos) + 1, l + 3).Value = sum
Cells(k + UBound(dos) + 1, l + 2).Value = "合計"

End Function

*1:x(i) - b(1