見出し画像

ちょうどいい感じの目盛りを求めるVBA

 Excelなどでグラフを書くと最大最小や目盛りは自動でそれなりにうまく書いてくれます。ちょっと気に入らない場合もありますが、とにかくどうやって求めているのだろうと考えて、あれこれ試してもうまくいきませんでした。
 調べていると、目盛の間隔は1,2,5の3通り(あるいはその10倍、100倍など)だという記述(*1)を見つけたので、それをもとにVBAを作りました。 考え方は、
     目盛間隔=(最大-最小)/分割数 
を求めた時に、目盛間隔を1,2,5に丸めてしまえばよいということです。
 プログラムは以下です。RoundMinMax に実データの最大、最小、目盛間隔(スケール、初期値不要)を与えると、いい感じの最大、最小、目盛間隔で上書きして返します。

'実データの最小最大を与えると、グラフの最大最小スケールで上書きして返す
Sub RoundMinMax(ByRef min As Double, ByRef max As Double, ByRef sca As Double, Optional yoyu As Double = 0.01, Optional NDiv As Long = 10, Optional NRuisin As Long = 1)
'yoyu = 0.01 '最大最小がスケールの倍数とぴったりにならないよう余裕を持たせる
If min = max Then
If max = 0 Then
max = 1
Else
max = 1.1 * min
End If
End If
sca = getScaleNum(min, max, NDiv, NRuisin)
min = sca * Int(min / sca - yoyu) 'スケールの倍数に合わせる
max = sca * Int(max / sca + 1 + yoyu) 'スケールの倍数に合わせる
End Sub
'目盛りの幅Scaleを返す。
Function getScaleNum(min As Double, max As Double, NDiv As Long, NRuisin As Long) As Double
Dim keta As Double, res As Double
Dim kisu As Variant, i As Long
'最終的に初期分割数の半分程度の分割目指す
'NDiv:初期分割数
'NRuisin = 1
kisu = Array(2, 5, 10, 20, 50, 100, 200, 500) '基数。目盛り幅はこれの倍数になる。
res = (max - min) / NDiv '暫定の目盛り間隔。
keta = 10# ^ Int(Log(res) / Log(10)) '目盛り間隔の位を調べる。
res = res / keta '目盛り間隔を1以上10未満の範囲に変換
For i = LBound(kisu) To UBound(kisu) '基数を大きくしていき
    If Int(res / kisu(i)) < 1 Then '基数で割って初めて1未満になる時
        'そのNRuisin分だけ後の基数を採用
        '初期分割数の半分程度の分割を目指すならNRuisin=1
        res = kisu(i + NRuisin) * keta
        Exit For
    End If
Next i
getScaleNum = res
End Functin

参考
1.グラフの目盛り間隔の求め方、https://www.eng.niigata-u.ac.jp/~nomoto/21.html、2022.02.14閲覧

応援してやろうということで、お気持ちをいただければ嬉しいです。もっと勉強したり、調べたりする糧にしたいと思います。