ナベアツ問題 -クイズ- [vba seminar in Monma Lab]

"ナベアツ問題"

"出力例"

3の倍数と3が付く数字だけアホになって、1000までいきます！

ナベアツさんは、最高2000まで数えたとか。

完成したら別Ver.も

サンプル01,02 : アホと表示

サンプル03 : 数字を漢字で表示

サンプル04 : 数字を漢数字で表示

"サンプルマクロ01"

"ヒント・解説01"

Public Sub Nabeatsu01()

Dim i As Integer

For i = 1 To 1000

    If i Mod 3 = 0 Or i Like "*3*" Then
        Cells(i, 1).Value = "アホ"
    Else
        Cells(i, 1).Value = i
    End If

Next i

End Sub

1. Like関数を使う。

2.ワイルドカード("*")を使って3の付く数字を判定する。

   * : 任意の0以上の文字

   ? : 任意の1文字

   # : 任意の数字

"サンプルマクロ02"

"ヒント・解説02"

Public Sub Nabeatsu02()

Dim i As Integer
Const n As Byte = 3
    
For i = 1 To 1000

    Cells(i, 3).Value = IIf(i Mod n = 0 Or i Like "*" & n & "*", "アホ", i)

Next i

End Sub

1.IIf関数を使って判定する

IIf(条件式,真の時の値,偽の時の値)

"サンプルマクロ03"

"ヒント・解説03"

Public Sub Nabeatsu03() '3のつく数字と3の倍数のとき漢字で言います

Dim i As Integer

For i = 1 To 1000

    If i Mod 3 = 0 Or i Like "*3*" Then
        Cells(i, 5).Value = WorksheetFunction.Text(i, "[DBNum1]") '数字を漢数字に変更
        Cells(i, 5).HorizontalAlignment = xlCenter '値を中央揃えにする
    Else
        Cells(i, 5).Value = i
    End If

Next i

Cells.EntireColumn.AutoFit 'セルの幅を最適化する

End Sub

1.WorksheetFunction.Textメソッドで表示書式を変更。

WorksheetFunction.Text(変更する値, "書式")

2.NumberString関数でも可

"サンプルマクロ04"

"ヒント・解説04"

Function SNum(num As Variant) As Variant

Dim d As Byte, d4 As Byte, d4mod As Byte, nullc As Byte
Dim e As Variant, f As Variant, g As Variant, h As Variant
Dim DN() As Variant, NS() As Variant
Dim x As Variant, y As Variant
Dim N1 As Variant, N2 As Variant, N3 As Variant

N1 = Array(Null, "壱", "弐", "参", "肆", "伍", "陸", "漆", "捌", "玖")
N2 = Array(Null, "拾", "珀", "阡")
N3 = Array(Null, "萬", "億", "兆", "京", "垓", "杼", "穣", "溝", "澗")

x = num: y = num

While x > 0 '桁取得

    d = d + 1: x = Fix(x / 10)
    
Wend

d4 = Fix((d - 1) / 4) 'N3
d4mod = d - (d4 * 4) 'N2

If d > 36 Then
    SNum = num: Exit Function '10^36以上の時数値を返す
ElseIf num < 0 Then
    SNum = num: Exit Function '0以下の時数値を返す
End If

ReDim DN(d - 1) As Variant

For e = d To 1 Step -1 'N1(各桁の値)

    DN(e - 1) = Fix(y / 10 ^ (e - 1))
    y = y - DN(e - 1) * 10 ^ (e - 1)

Next e

For h = d4 To 0 Step -1 'N3

    For f = IIf(h = d4, d4mod - 1, 3) To 0 Step -1 'N1&N2
        
        g = g & IIf(f <> 0 And DN(4 * h + f) = 1, Null, N1(DN(4 * h + f))) _
              & IIf(DN(4 * h + f) = 0, Null, N2(f)) '0ならN2桁非表示
        
        nullc = IIf(DN(4 * h + f) = 0, nullc + 1, nullc) '0の回数カウント
        
    Next f
    
    g = g & IIf(nullc = 4, Null, N3(h)): nullc = 0 '0000ならN3桁をつけない
    
Next h

SNum = g '((N1 & N2)^f & N3)^h

End Function


Public Sub Nabeatsu04()

Const m As Byte = 3 'mのつく数字、mの倍数
Const n As Long = 1000 '最大数 (<65536)

Dim i As Long

For i = 1 To n

    Cells(i, 7).Value = IIf(i Mod m = 0 Or i Like "*" & m & "*", SNum(i), i)
    Cells(i, 7).HorizontalAlignment = IIf(i Mod m = 0 Or i Like "*" & m & "*", xlCenter, xlRight)
    
Next i
    
End Sub

1.数字を漢数字に変換するSNum()関数を作る。

2.作成した関数を使って数字を漢数字にする。