VBA練習問題
VBA100本ノック 魔球編:2桁の最小公倍数

VBAを100本の練習問題で鍛えます
公開日:2021-02-02 最終更新日:2021-02-05

VBA100本ノック 魔球編:2桁の最小公倍数


任意の重複しない5つの2桁の数値を選び、最小公倍数が2桁である5つの数値を見つける問題です。


ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。


出題

出題ツイートへのリンク

#VBA100本ノック 魔球編
全て違う2桁の正の整数が5つあるとき、最小公倍数が2桁の数値になる数値の組み合わせを全て求めてください。
言い方を変えて再度、
2桁とは10~99、この中から5つの違う数値を選び最小公倍数を求め、その結果が2桁(10~99)になる5つの数値の組み合わせを全て求める。


たぶん、最初の文章がいけないんですね。
後半の文章の方が伝わる気がします。
任意の重複しない5つの2桁の数値を選び、最小公倍数が2桁である5つの数値を見つけるという事です。


今どきのPC性能を甘く見ていたようです。
5つでは結構簡単に算出できてしまうらしいです。
では、6つの数値ならどうか。
異なる2桁の6つの数値の最小公倍数が2桁になるものはあるのか?
まあ、あるのは確かなんですけど・・・


VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。


他の人の回答および解説を見て、書いたVBAを見直してみましょう。


頂いた回答

解答

5つの数値を総当たりはさすがに辛いですね。
2桁の最小公倍数から逆算します。
14~99の約数のうち、2桁になる数値が5つあれば良いという事です。
頂いた回答にも多くありましたし、恐らくこの方法が最も速く計算できるだろうと思います。

以下のVBAでは、n桁m個に対応させました。
引数で指定n桁m個を指定します。
テスト実行用のコードもそのまま掲載しました。
VBAコードの下には実行結果のイミディエイト ウィンドウも出しておきました。

実行時間は計測しませんでしたが、5桁になるとこれでもかなり時間がかかっていました。


解答VBAコード

Sub 魔球編3_main()
  Dim d, n
  d = 2: n = 5: Call 魔球編3(d, n, True)
  d = 2: n = 6: Call 魔球編3(d, n)
  d = 3: n = 5: Call 魔球編3(d, n)
  d = 3: n = 6: Call 魔球編3(d, n)
  d = 3: n = 7: Call 魔球編3(d, n)
  d = 4: n = 6: Call 魔球編3(d, n)
  d = 4: n = 7: Call 魔球編3(d, n)
  d = 4: n = 8: Call 魔球編3(d, n)
  d = 5: n = 7: Call 魔球編3(d, n)
  d = 5: n = 8: Call 魔球編3(d, n)
  d = 5: n = 9: Call 魔球編3(d, n)
End Sub

Sub 魔球編3(ByVal d As Long, ByVal n As Long, Optional isLog As Boolean)
  Dim aryDiv()
  Dim i As Long, j As Long, k As Long, ix As Long
  Dim ansBin As String, tmpBin As String
  Dim isOk As Boolean, sOut As String, cnt As Long
  
  For i = 10 ^ (d - 1) + n - 1 To 10 ^ d - 1
    ix = 1
    For j = 2 To i
      If i Mod j = 0 Then
        If j >= 10 ^ (d - 1) Then
          ReDim Preserve aryDiv(1 To ix)
          aryDiv(ix) = j
          ix = ix + 1
        End If
      End If
    Next
    
    cnt = cnt + n個の組み合わせ(i, aryDiv, d, n, isLog)
  Next
  
  Debug.Print d & "桁" & n & "個:" & cnt
End Sub

Function n個の組み合わせ(ByVal i As Long, ByRef aryDiv(), ByVal d As Long, ByVal n As Long, isLog As Boolean) As Long
  Dim j As Long, k As Long, cnt As Long
  Dim sOut As String, sBin As String
  Dim wsf As WorksheetFunction: Set wsf = WorksheetFunction
  
  For j = wsf.Bin2Dec(String(n, "1")) To 2 ^ UBound(aryDiv) - 1
    sBin = wsf.Dec2Bin(j, UBound(aryDiv))
    If Len(sBin) - Len(Replace(sBin, "1", "")) = n Then
      sOut = ""
      For k = 1 To UBound(aryDiv)
        If Mid(sBin, k, 1) = "1" Then
          If aryDiv(k) < 10 ^ (d - 1) Then
            sOut = ""
            Exit For
          Else
            If sOut <> "" Then sOut = sOut & ","
            sOut = sOut & aryDiv(k)
          End If
        End If
      Next
      If sOut <> "" Then
        If isLog Then Debug.Print sOut & " ⇒ " & i
        cnt = cnt + 1
      End If
    End If
  Next
  
  n個の組み合わせ = cnt
End Function


マクロ VBA 100本ノック




同じテーマ「VBA100本ノック」の記事

95本目:図形のテキストを検索するフォーム作成
96本目:Accessデータを取得(マスタ結合&抽出)
97本目:Accessデータを取得(グループ集計)
98本目:席替えルールが守られているか確認
99本目:自動席替え(行列と前後左右が全て違うように)
100本目:WEBから100本ノックのリストを取得
魔球編:組み合わせ問題
魔球編:閉領域の塗り潰し
迷宮編:巡回セル問題
魔球編:2桁の最小公倍数
参加者様ご紹介


新着記事NEW ・・・新着記事一覧を見る

VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE|エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。|エクセル雑感(2023-12-28)
VBAでクリップボードへ文字列を送信・取得する3つの方法|VBA技術解説(2023-12-07)
難しい数式とは何か?|エクセル雑感(2023-12-07)
スピらない スピル数式 スピらせる|エクセル雑感(2023-12-06)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.並べ替え(Sort)|VBA入門
8.条件分岐(IF)|VBA入門
9.セルのクリア(Clear,ClearContents)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ