VBA 測定単位を計算する(関数)

Function Unit(x() As Double) As Double()
Dim i As Integer
Dim n As Integer
Dim a As Integer
Dim m As Double
Dim j As Integer
Dim x_k() 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
x_k = x

For i = 1 To UBound(x)
x_k(i) = 10 ^ (n - 1) * x(i)
Next i

For i = Int*1 ^ 0.5) + 1 To 1 Step -1
a = 1
For j = 1 To UBound(x)

If x_k(j) Mod i <> 0 Then
a = 0
Exit For
End If

Next j
If a = 1 Then
m = i
Exit For
End If
Next i

m = 10 ^ (-n + 1) * m
Cells(1, 1).Value = "測定単位 : " & m
End Function

*1:max * 10 ^ (n - 1