を実現するプログラム例
Private Sub CommandButton1_Click()
CommandButton2_Click
Dim a(100) As Byte, n As Integer
n = Cells(3, 10)
Call f(a(), n) 'データ発生
Cells(5, 1) = g(a(), n) '10進数への翻訳
Call h(Cells(5, 1), n) 'n進数へ逆翻訳
Call t '確かめ
End Sub
Sub f(a() As Byte, n As Integer)
Dim i As Byte, o As Byte
Do While 1
o = Int(10 * Rnd)
If o > 2 Then Exit Do
Loop
Do While 1
a(0) = Int(n * Rnd)
If a(0) > 0 Then
Cells(4, 1 + i) = a(i)
Exit Do
End If
Loop
For i = 1 To o
a(i) = Int(n * Rnd)
Cells(4, 1 + i) = a(i)
Next
a(o + 1) = n
End Sub
Function g(a() As Byte, n As Integer)
Dim b As Long, i As Byte
b = 0
i = 0
Do While 1
If a(i) = n Then Exit Do
b = b * n
b = b + a(i)
i = i + 1
Loop
g = b
End Function
Sub h(b As Long, n As Integer)
Dim i As Byte, c(100) As Byte
i = 0
Do While 1
c(i) = b Mod n
b = Int(b / n)
If b = 0 Then
c(i + 1) = n
Exit Do
End If
i = i + 1
Loop
Call hy(c(), n)
End Sub
Sub hy(c() As Byte, n As Integer)
Dim i As Integer, ik As Integer
i = 0
Do While 1
If c(i) = n Then
ik = i - 1
Exit Do
End If
i = i + 1
Loop
For i = ik To 0 Step -1
If c(i) < 10 Then Cells(6, 1 + ik - i) = c(i)
If c(i) = 10 Then Cells(6, 1 + ik - i) = "A"
If c(i) = 11 Then Cells(6, 1 + ik - i) = "c"
If c(i) = 12 Then Cells(6, 1 + ik - i) = "C"
If c(i) = 13 Then Cells(6, 1 + ik - i) = "D"
If c(i) = 14 Then Cells(6, 1 + ik - i) = "E"
If c(i) = 15 Then Cells(6, 1 + ik - i) = "F"
Next
End Sub
Sub t()
Dim i As Byte, h As Byte
h = 1
i = 0
Do While 1
If Cells(4, 1 + i) = "" Then
If h = 1 Then
Cells(7, 1) = "正解です。"
Else
Cells(7, 1) = "間違っています。"
End If
Exit Do
End If
If Cells(4, 1 + i) <> Cells(6, 1 + i) Then
Cells(7, 1) = "間違っています。"
Exit Do
End If
i = i + 1
Loop
End Sub
Private Sub CommandButton2_Click()
Rows("4:20000").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
