VB常见程序.doc

找鞍点Private Sub Form_Click()Dim a(4, 5) As Integerf = 0For i = 1 To 4 For j = 1 To 4 a(i, j) = Int(Rnd * 100) + 10 Print a(i, j); Next j PrintNext iFor i = 1 To 4Max = a(i, 1)For j = 1 To 5If a(i, j) Max ThenMax = a(i, j)b = jEnd IfNext jflag = 1For k = 1 To 4If a(k, b) = A Then n = Asc(Mid(s, i, 1) - Asc(A) + 10 Else n = Val(Mid(s, i, 1) End If tran_dec = tran_dec + n * r (Len(s) - i)Next iEnd FunctionPrivate Sub Text2_Change() num = Val(Text2.Text)End Sub逆序输出Option Base 1Private Sub Command1_Click()Dim s As String, flg As Boolean, a() As Integer, x As Long, k As Longs = Text1.Textk = Val(Text1.Text)flg = judge(s)If flg = True Then x = rever(k) Text2 = x ElseIf flg = False Then MsgBox 输入数据不是满足条件的数 Text2 = 请重新输入 Text1 = Text1.SetFocus Exit Sub End IfEnd SubPrivate Sub Command2_Click()EndEnd SubPrivate Function judge(ByVal s As String) As BooleanDim b() As Integer, n As Integer, i As Integern = Len(CStr(s)For i = 1 To n ReDim Preserve b(i)b(i) = s Mod 10s = s 10Next i If UBound(b) = 4 And b(1) 0 Then judge = True End IfEnd FunctionPrivate Function rever(ByVal n As Long) As LongDo r = n Mod 10rever = rever * 10 + rn = n 10Loop While n 0End Function选择排序法1 2 3 5 45 1 2 3 45 4 1 2 35 4 3 1 25 4 3 2 1 For i = 1 To 4 For j = i + 1 To 5 If sort(i) sort(j) Then temp = sort(i) sort(i) = sort(j) sort(j) = temp End If Next jNext i直接排序法 1 2 3 5 45 2 3 1 45 4 3 1 25 4 3 1 25 4 3 2 1For i = 1 To 4 pointer = i For j = i + 1 To 5 If sort(pointer) sort(j) Then pointer = j End If Next j If i pointer Then temp = sort(i) sort(i) = sort(pointer) sort(pointer) = temp End IfNext i冒泡排序法9 4 7 5 24 7 5 2 94 5 2 7 94 2 5 7 92 4 5 7 9For i = 1 To 9 For j = 1 To 10 - i If s(j) s(j + 1) Then t = s(j) s(j) = s(j + 1) s(j + 1) = t End If Next jNext i将一个数列中的重复数删除ub = UBound(a)n = 1Do While n ub i = n + 1 Do While i = ub If a(n) = a(i) Then For j = i To ub - 1 a(j) = a(j + 1) Next j ub = ub - 1 ReDim Preserve a(ub) Else i = i + 1 End If Loop n = n + 1Loop二分法查找 find = InputBox(输入要查找的数) left = 1: right = UBound(search) flg = False Do While left search(mid) Then left = mid + 1 Else right = mid - 1 End If Loopif flg Then Text2 =要查找的数 & Str(search(mid) & 是search( & Str(mid) & )中Else Text2 = Str(find) & 不在数组中End If顺序查找法find = InputBox(输入要查找的数) For i = 1 To UBound(search) If search(i) = find Then Exit For Next i If i = UBound(search) Then Text2 = 要查找的数 & Str(search(i) & 是search( & Str(i) & ) Else Text2 = 在数列中没有找到 & Str(find) End IfPrivate Sub Form_Click() 求两个整数的最大公约数 Dim N As Integer, M As Integer, G As Integer N = InputBox(输入N): M = InputBox(输入M) G = Gcd(N, M) Print N; 和; M; 的最大公约数是:; GEnd Sub求两个数最大的公约数Private Function Gcd(ByVal A As Integer, ByVal B As Integer) Dim R As Integer R = A Mod B Do While R 0 A = B B = R R = A Mod B Loop Gcd = BEnd Function找出5000以内的亲密对数。所谓“亲密对数”，是指甲数的所有因子和等于乙数，乙数的所有因子和等于甲数，那么甲、乙两数为亲密对数。Private Sub Command1_Click() Dim i As Integer, sum1 As Integer, sum2 As Integer For i = 1 To 5000 Call Sum_factors(i, sum1) Call Sum_factors(sum1, sum2) If i = sum2 And i sum1 Then Print i, sum1 End If Next iEnd SubPrivate Sub Sum_factors(ByVal n As Integer, sum As Integer) Dim i As Integer sum = 0 For i = 1 To n - 1 If n Mod i = 0 Then sum = sum + i End If Next iEnd Sub求n!Private Sub Form_Click( )Dim N as Integer, F as Long N = InputBox(