柿×食う＝客 ② ループを極力減らす

昨日は、算数パズル「かき×くう＝きゃく」を、マクロで無理やり解いてみた。
infoment.hatenablog.com
この問題では、「か・き・く・う・や」で表される５つの数字が登場する。従って昨日は、何も考えずにFor ～ Nextの５重ループを作成して問題を解いた。

しかし、これは中々面倒の話だ。もし５文字ではなく１０文字だったら？２０文字だったら？考えただけで、ゾッとする（※）。
※０～９の１０通りしかないため、本当は２０文字は有り得ない。

そこで今回は、何文字であろうとループが一回で済むよう改修してみる。

昨夜の五重ループは、表にすると、このようになる。

ということは、11110 ～ 99999 の5桁をループさせるのと同じだ。
何桁であろうと、ループは１個で済む。
では、どこからどこまで数字を変化させればよいか。簡単のため、「か」は０にならない前提を加味すると、以下で表すことが出来る。

• 最小値：10の（桁数-1）乗 ⇒ 10^(5-1)=10000
• 最大値：10の桁数乗-1 ⇒ 10^5-1=99999

Sub 算数パズル()

    Dim か As Long
    Dim き As Long
    Dim く As Long
    Dim う As Long
    Dim や As Long
    
    Dim 乗数 As Long
    Dim 被乗数 As Long
    Dim 答え As Long
    
    Dim 桁数 As Long
        桁数 = 5
    Dim iMin As Long
        iMin = 10 ^ (桁数 - 1)
    Dim iMax As Long
        iMax = 10 ^ 桁数 - 1
    
    Dim 重複確認 As Dictionary
    Dim i As Long
    
        For i = iMin To iMax
            か = Mid(i, 1, 1)
            き = Mid(i, 2, 1)
            く = Mid(i, 3, 1)
            う = Mid(i, 4, 1)
            や = Mid(i, 5, 1)
            If か <> 0 And き <> 0 And く <> 0 Then
                乗数 = か * 10 + き
                被乗数 = く * 10 + う
                答え = き * 100 + や * 10 + く
                If 乗数 * 被乗数 = 答え Then
                    Set 重複確認 = New Dictionary
                    重複確認(か) = か
                    重複確認(き) = き
                    重複確認(く) = く
                    重複確認(う) = う
                    重複確認(や) = や
                    If UBound(重複確認.Keys) = 4 Then
                        MsgBox "か：" & か & vbNewLine & _
                               "き：" & き & vbNewLine & _
                               "く：" & く & vbNewLine & _
                               "う：" & う & vbNewLine & _
                               "や：" & や
                    End If
                End If
            End If
        Next

End Sub

少し短くなった。重複確認部分が未だ重たいので、外に出してみる。

Sub 算数パズル()

    Dim か As Long
    Dim き As Long
    Dim く As Long
    Dim う As Long
    Dim や As Long
    
    Dim 乗数 As Long
    Dim 被乗数 As Long
    Dim 答え As Long
    
    Dim 桁数 As Long
        桁数 = 5
    Dim iMin As Long
        iMin = 10 ^ (桁数 - 1)
    Dim iMax As Long
        iMax = 10 ^ 桁数 - 1
    
    Dim i As Long
    
        For i = iMin To iMax
            If 重複確認(i, 桁数) = False Then
                か = Mid(i, 1, 1)
                き = Mid(i, 2, 1)
                く = Mid(i, 3, 1)
                う = Mid(i, 4, 1)
                や = Mid(i, 5, 1)
                If か <> 0 And き <> 0 And く <> 0 Then
                    乗数 = か * 10 + き
                    被乗数 = く * 10 + う
                    答え = き * 100 + や * 10 + く
                    If 乗数 * 被乗数 = 答え Then
                        MsgBox "か：" & か & vbNewLine & _
                               "き：" & き & vbNewLine & _
                               "く：" & く & vbNewLine & _
                               "う：" & う & vbNewLine & _
                               "や：" & や
                    End If
                End If
            End If
        Next

End Sub

Function 重複確認(val As Long, 桁数 As Long) As Boolean
    Dim Dict As Dictionary
    Set Dict = New Dictionary
    
    Dim i As Long
    For i = 1 To 桁数
        If Dict.Exists(Mid(val, i, 1)) Then
            重複確認 = True
            Exit For
        Else
            Dict(Mid(val, i, 1)) = Mid(val, i, 1)
        End If
    Next
End Function

一応動くが、何だか極端に遅くなってしまった。

その他も含め、明日も色々と改善に挑戦してみよう。

参考まで。