今日の日付を素因数分解するマクロ

日々のできごと

2025.03.16

ふと思いついて、今日の日付を(yyyymmdd)のように8桁の数字に置き換えて素因数分解することを思いつきました。これだとブログネタにして毎日更新できそうです。ただ8桁の数字を素因数分解するのはかなり至難の業であることは容易に想像ができます。例えば4桁の数字9999を考えてみると3で割って3333、さらに3で割ると1111になりますが、次に割れる数字となると11までなくてそれで割ると101になります。101は素数ですから9999の素因数は 3^2、11，101ということになります。これは、まだわかりやすい方です。

では13×17×19=4199を考えた時に左辺のかけ算は容易にできますが、右辺を素因数分解しようとすると2、3，5，7，11までは割れなくてやっと13で割ることができ4199/13=323になります。323は素数ではないので2、3，5，7，11、13まで割れずにやっと17で割ることができ、素因数が13、17，19だとわかる次第です。

ChatGPTに「人が素因数分解できるのは何桁ぐらいですか？」と聞いてみると、返ってきたのは

4～6桁：数学が得意な人なら比較的短時間で可能
7～8桁：時間はかかるが、根気があれば可能
9桁以上：非常に困難で、特に素因数が大きい場合はほぼ不可能　とのことでした。

ChatGPTがいう「数学が得意な人」は、「計算が得意な人」の方がいいような気がするのですが、まぁ数学の得意な人は100までの素数をすらすら言えるので「9991」を素因数分解するのもたやすい、ということなのかもしれません。因みに9991は100までにある素数25個のうち25番目にある97まで割ることができません。

だいぶ脇道にそれてしまいました。本題の「今日の日付を(yyyymmdd)のように8桁の数字に置き換えて素因数分解」に戻します。結論から言うとChatGPTは「時間はかかるが、根気があれば可能」と言うものの、手計算ではかなりしんどいだろう、ということです。そんなときはコンピューターにやって貰いましょう。ということで、再度ChatGPTに「Excelで素因数分解をして、同時に素数かどうかの判定をおこなうVBAマクロを教えて」と頼んでみました。

以下のコードをExcelのVBA標準モジュールに組み込むだけで。任意の整数を素因数分解してくれます。

Sub FactorizeAndCheckPrime()
    Dim num As Long, n As Long, factor As Long
    Dim result As String
    Dim isPrime As Boolean
    Dim ws As Worksheet
    
    ' アクティブシートの選択セルから数値を取得
    Set ws = ActiveSheet
    num = ws.Range("A1").Value ' A1セルの値を取得
    
    ' 数値が2未満なら処理を中止
    If num < 2 Then
        MsgBox "2以上の整数を入力してください。", vbExclamation
        Exit Sub
    End If
    
    ' 素因数分解の初期化
    n = num
    result = ""
    isPrime = True ' 初期状態は素数と仮定
    
    ' 2で割れる限り割る
    factor = 2
    Do While n Mod factor = 0
        result = result & factor & " × "
        n = n \ factor
        isPrime = False ' 割り切れたら素数ではない
    Loop
    
    ' 3以上の奇数で試す
    factor = 3
    Do While factor * factor <= n
        Do While n Mod factor = 0
            result = result & factor & " × "
            n = n \ factor
            isPrime = False
        Loop
        factor = factor + 2
    Loop
    
    ' 最後にnが1より大きければ、それは素数
    If n > 1 Then
        result = result & n
    Else
        ' 最後の " × " を削除
        If Right(result, 3) = " × " Then
            result = Left(result, Len(result) - 3)
        End If
    End If
    
    ' 結果を表示
    If isPrime Then
        MsgBox num & " は素数です。", vbInformation
    Else
        MsgBox num & " の素因数分解: " & result, vbInformation
    End If
    
    ' 結果をB1セルに表示
    ws.Range("B1").Value = result
    
End Sub