t-hom’s diary

主にVBAネタを扱っているブログです。

VBA 連続して与えられた数の最大値、最小値を求めるクラス

今回は連続して値を投げ込み、その最大値・最小値を求めるクラスを紹介する。
かなりシンプルなのでわざわざ記録しておくこともないかなと迷ったけど、クラス初心者向けにはちょうど良いサンプルになりそうなのでとりあえず。

クラスモジュールのコード

クラス名はNumericAggregationObjectとし、次のコードを張り付ける。

Public Data As Collection
Public Max As Variant
Public Min As Variant
Public Sum As Variant
Public Property Get Avg() As Variant
    Avg = Sum / Data.Count
End Property

Sub Add(x As Variant)
    If Data.Count = 0 Then
        Max = x
        Min = x
    End If
    If Max < x Then Max = x
    If Min > x Then Min = x
    Sum = Sum + x
    Data.Add x
End Sub

Private Sub Class_Initialize()
    Set Data = New Collection
    Max = 0
    Min = 0
    Sum = 0
End Sub

まぁ見ての通り、オブジェクト外からデータ書き換えし放題のゆるゆるクラス。
個人で使うには十分だけど、クリティカルな業務で使おうと思ったらPropertyでアクセサ作って不正データブロックするなり、もう少しセキュアにした方が良い。

使い方

こちらのサンプル参照。

Sub Sample()
    Dim nao As NumericAggregationObject
    Set nao = New NumericAggregationObject
    nao.Add 10
    nao.Add 12
    nao.Add 9
    Debug.Print "Max:" & nao.Max
    Debug.Print "Min:" & nao.Min
    Debug.Print "Sum:" & nao.Sum
    Debug.Print "Avg:" & nao.Avg
End Sub

動機

これを作った動機はExcel VBAのユーザーフォーム設計で、テキストボックスの最適幅を求める課題が生じたこと。
f:id:t-hom:20190504101018p:plain

Meiryo UIはプロポーショナルフォントなので、テキストの内容によって幅が伸縮する。
以前は以下のテキストを使用して幅を作っていたんだけど、実際に自然な文章を入れてみると幅が結構ズレるので、今回は実際の文章を使って最大幅を見つけることにした。
"■■■■■□□□□□■■■■■□□□□□■■■■■□□□□□■■■■■□□□□□"

どうやってやったかは、以下のとおり。

1) ブログから適当な文章を持ってきてSheet1のA1セルに張り付ける。
f:id:t-hom:20190504102208p:plain
2) 改行を除去
f:id:t-hom:20190504102326p:plain
f:id:t-hom:20190504102353p:plain
3) 以下の記事から幅取得用のモジュールを準備
thom.hateblo.jp
※使うのはMeasureTextWidth関数
4) 80バイト切り出したときの最大幅を取得

Sub 最大幅取得()
    Dim t As String
    t = String(80, "*")
    Dim n As Long: n = 1
    Dim nao As NumericAggregationObject
    Set nao = New NumericAggregationObject
    Do While LenB(t) >= 80
        t = MidB(Sheet1.Range("A1"), n, 80)
        w = MeasureTextWidth(t, "Meiryo UI")
        nao.Add w
        n = n + 2
    Loop
    Debug.Print nao.Max
End Sub

実行結果は283と出た。

5) 最大幅に合致する文を取得

Sub 最大幅に合致する文を取得()
    Const 最大幅 = 283
    Dim t As String
    t = String(80, "*")
    n = 1
    Do While LenB(t) >= 80
        t = MidB(Sheet1.Range("A1"), n, 80)
        w = MeasureTextWidth(t, "Meiryo UI")
        If w = 最大幅 Then Debug.Print t
        n = n + 2
    Loop
End Sub

実行結果は「の呼び出し履歴は、一番上が中断したプロシージャ、二番目がその呼び出し元、三番目が」となった。

6) この文をテキストボックスのTextプロパティに入れて、ぎりぎり入る幅にする。
テキストボックスのWidthプロパティを見て、キリの良い数字に切り上げる。(450にした)

以上

これでまぁ大半のテキストはうまく収まると思われる。

ちなみにこれで、私が作るユーザーフォームは基準値が出そろった。

Font.Name Meiryo UI
Font.Size 12
BorderStyle fmBorderStyleSingle
Height 15 × 行数 + 6
Width(最大) 450(1カラムレイアウト時)

Heightの計算式の根拠については以下の記事を参照
thom.hateblo.jp

Font.Sizeの根拠については以下の記事を参照
thom.hateblo.jp

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。