第５話 引き算プログラム例
を実現するプログラム例
Private Sub CommandButton1_Click()
CommandButton2_Click
Dim a(100) As Integer, b(100) As Integer, c(100) As Integer, n As Integer, i As Integer
n = Cells(3, 10)
Call f(a(), n) 'データ発生
Call f(b(), n) 'データ発生
Call g(a(), b(), n) '表示
Call hz(a(), b(), c(), n) '引き算
End Sub
Sub f(a() As Integer, n As Integer)
Dim i As Integer, o As Integer
Do While 1
o = Int(10 * Rnd)
If o > 2 Then Exit Do
Loop
For i = 0 To o - 1
a(i) = Int(n * Rnd)
Next
Do While 1
a(o) = Int(n * Rnd)
If a(o) > 0 Then
Exit Do
End If
Loop
a(o + 1) = n
End Sub
Sub g(a() As Integer, b() As Integer, n As Integer)
Dim i As Integer, ik1 As Integer, ik2 As Integer, mx As Integer
i = 0
Do While 1
If a(i) = n Then
ik1 = i
Exit Do
End If
i = i + 1
Loop
i = 0
Do While 1
If b(i) = n Then
ik2 = i
Exit Do
End If
i = i + 1
Loop
mx = ik1
If mx < ik2 Then mx = ik2
Cells(4, 1) = "a="
For i = 0 To ik1 - 1
Cells(4, 2 + mx - i) = a(i)
Next
Cells(5, 1) = "b="
For i = 0 To ik2 - 1
Cells(5, 2 + mx - i) = b(i)
Next
End Sub
Function h(a() As Integer, b() As Integer, n As Integer)
Dim i As Integer, ik1 As Integer, ik2 As Integer, mx As Integer
i = 0
Do While 1
If a(i) = n Then
ik1 = i
Exit Do
End If
i = i + 1
Loop
i = 0
Do While 1
If b(i) = n Then
ik2 = i
Exit Do
End If
i = i + 1
Loop
If ik1 > ik2 Then
h = 2
Exit Function
End If
If ik1 < ik2 Then
h = 0
Exit Function
End If
For i = ik1 - 1 To 0 Step -1
If a(i) > b(i) Then
h = 2
Exit Function
End If
If a(i) < b(i) Then
h = 0
Exit Function
End If
Next
h = 1
End Function
Sub hz(a() As Integer, b() As Integer, c() As Integer, n As Integer)
Dim d(100) As Integer, e(100) As Integer, i As Integer, j As Integer
Dim ik1 As Integer, ik2 As Integer, mx As Integer, hn As Integer
hn = h(a(), b(), n)
If hn > 0 Then
i = 0
Do While 1
If a(i) = n Then
ik1 = i
Exit Do
End If
d(i) = a(i)
i = i + 1
Loop
i = 0
Do While 1
If b(i) = n Then
ik2 = i
Exit Do
End If
e(i) = b(i)
i = i + 1
Loop
Else
i = 0
Do While 1
If a(i) = n Then
ik1 = i
Exit Do
End If
e(i) = a(i)
i = i + 1
Loop
i = 0
Do While 1
If b(i) = n Then
ik2 = i
Exit Do
End If
d(i) = b(i)
i = i + 1
Loop
End If
mx = ik1
If mx < ik2 Then mx = ik2
i = 0
Do While 1
If i = mx Then Exit Do
Cells(6, 2 + mx - i) = d(i)
i = i + 1
Loop
i = 0
Do While 1
If i = mx Then Exit Do
Cells(7, 2 + mx - i) = e(i)
i = i + 1
Loop
For i = 0 To mx - 1
If d(i) < e(i) Then
For j = i + 1 To mx - 1
If d(j) > 0 Then
d(j) = d(j) - 1
Exit For
Else
d(j) = n - 1
End If
Next
d(i) = d(i) + n
End If
c(i) = d(i) - e(i)
Next
For i = mx To 0 Step -1
If c(i) > 0 Then
If hn > 0 Then
c(i + 1) = n
Else
c(i + 2) = n
c(i + 1) = n + 1
End If
Exit For
End If
Next
Cells(8, 1) = "a-b="
i = 0
Do While 1
If c(i) = n Then Exit Do
If c(i) < n Then Cells(8, 2 + mx - i) = c(i)
If c(i) = n + 1 Then Cells(8, 2 + mx - i) = " -"
i = i + 1
Loop
End Sub
Private Sub CommandButton2_Click()
Rows("4:20000").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
難しいですよね。
私もはじめて考えたときは、
頭が爆発しそうになりました。
コードを見ても「わからない、わからない、わからない、わからない、・・・」
ですよね。
次話で詳しく解説しましょう。
