DOC

# vb

By Elsie Lawrence,2014-08-03 14:25
10 views 0
vb vb vb vb vb vb vb vb vb vb vb vb

公式:Int(Rnd*(B-A+1)+A) 1.循环

1，打印三角形

方法一，用单重循环

Private Sub Form_Click() For i = 1 To 8

Print Tab(15 - i); String(2 * i - 1, "*")

Next i

End Sub

方法二，用多重循环

Private Sub Form_Click() For i = 1 To 8

Print Tab(15 - i);

For j = 1 To 2 * i - 1 Print "*";

Next j

Print

Next i

End Sub

(2)求积数部分和

Private Sub Form_Click() Dim i As Integer

For i = 1 To 99 Step 2 s = s + i

Next i

Print s

End Sub

3，求100200之间的所有素数。

Private Sub Form_Click() Dim t As Boolean

For x = 101 To 200 Step 2 t = True

For i = 2 To x - 1

If x Mod i = 0 Then t = False Next i

If t Then

k = k + 1

Print x;

If k Mod 10 = 0 Then Print End If

Next x

End Sub

4，最大公约数、最小公倍数

Private Sub Form_Click()

n1 = InputBox("输入 n")

m1 = InputBox("输入 m")

If m1 > n1 Then

m = m1: n = n1

Else

m = n1: n = m1

End If

r = m Mod n

Do While r <> 0

m = n

n = r

r = m Mod n

Loop

Print m1; ","; n1; "的最大公约数="; n

Print "最小公倍数=", m1 * n1 / n End Sub

5，水仙花数

Private Sub Form_Click() For i = 100 To 999

x = Int(i / 100)

y = Int((i - x * 100) / 10) z = i - x * 100 - y * 10 If i = x * x * x + y * y * y + z * z * z Then

Print i,

End If

Next i

End Sub

(6)最大值、最小值。

例题 100 200 500 700 8000 900 250 360

中的最大值和最小值

Private Sub Form_Click()

Dim arrNum(7) As Long Dim lngMax As Long

Dim lngMin As Long

Dim i As Integer

arrNum(0) = 100

arrNum(1) = 200

arrNum(2) = 500

arrNum(3) = 700

arrNum(4) = 8000

arrNum(5) = 900

arrNum(6) = 250

arrNum(7) = 360

lngMin = arrNum(0)

For i = LBound(arrNum) To UBound(arrNum)

If arrNum(i) > lngMax Then

lngMax = arrNum(i)

End If

If arrNum(i) < lngMin Then

lngMin = arrNum(i)

End If

Next

MsgBox "max: " & lngMax & vbCrLf & "min: " & lngMin

End Sub

Private Sub Form_Click() Dim AA(10) As Long

Dim IntMax, IntMin As Long

AA(0) = 100

AA(1) = 200

AA(2) = 500

AA(3) = 700

AA(4) = 8000

AA(5) = 900

AA(6) = 250

AA(7) = 360

AA(8) = 1

AA(9) = 10000

IntMax = AA(0)

IntMin = AA(0)

For i = 1 To 9

If AA(i) > IntMax Then

IntMax = AA(i)

End If

If AA(i) < IntMin Then

IntMin = AA(i)

End If

Next i

MsgBox "最大是: " & IntMax

MsgBox "最小是: " & IntMin

End Sub

Private Sub Command1_Click() getmaxmin 100, 200, 500, 700, 8000, 900, 250, 360

End Sub

Sub getmaxmin(ParamArray a()) Dim i As Long, max As Double, min As Double

max = a(0)

min = a(0)

For i = 0 To UBound(a)

max = IIf(max < a(i), a(i), max) min = IIf(min < a(i), min, a(i)) Next

MsgBox "max number: " & max & vbCrLf & "min number: " & min

End Sub

2 数组

1，排序 从小到大排序

Private Sub Form_Click() Dim a() As Integer

n = Val(InputBox("n"))

ReDim a(1 To n) As Integer Randomize

For i = 1 To n

a(i) = Int(Rnd * 101 + 100) Print a(i);

If i Mod 10 = 0 Then Print Next i

For i = 1 To n - 1

k = i

For j = i + 1 To n

If a(k) > a(j) Then k = j Next j

t = a(i): a(i) = a(k): a(k) = t Next i

For i = 1 To n

Print a(i);

If i Mod 10 = 0 Then Print Next i

End Sub

(2)杨辉三角形

Private Sub command1_Click() Dim a(9, 9) As Integer, i As Integer

Dim j As Integer, m As Integer For i = 0 To 9

a(i, i) = 1

a(i, 0) = 1

Next i

For i = 2 To 9

m = i - 1

For j = 1 To m

a(i, j) = a(m, j - 1) + a(m, j)

Next j

Next i

For i = 0 To 9

For j = 0 To i

Picture1.Print a(i, j);

Next j

Picture1.Print

Next i

End Sub

s=4!+5!+6!

Private Sub form_click() Print fax(4) + fax(5) + fax(6) End Sub

Private Function fax(k As Integer) As Single

t = 1

For i = 2 To k

t = t * i

Next i

fax = t

End Function

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

If Not IsNumeric(Text1) Then

MsgBox "输入非数字串！重新输入"

Text1.Text = ""

Text1.SetFocus

Else

If ish(Text1) Then

Picture1.Print Text1; "?"

Else

Picture1.Print Text1

End If

Text1 = ""

End If

End If

End Sub

Function ish(ss As String) As Boolean

Dim i%, ls%

ish = True

ss = Trim(ss)

ls = Len(ss)

For i = 1 To ls \ 2

If Mid(ss, i, 1) <> Mid(ss, ls + 1 - i, 1) Then

ish = False

Exit Function

End If

Next i

End Function

Private Sub Form_Click() Dim a As String

Print htod(a), Hex(htod(a)) End Sub

Private Function htod(h As String) As Double

For i = 1 To Len(h)

m = UCase(Mid(h, i, 1)) If m >= "A" And m <= "F" Then x = Asc(m) - 65 + 10

Else

x = Val(m)

End If

s = s + x * 6 ^ (Len(h) - i) Next i

htod = s

End Function

D:\TT\T.DAT

每个学生包括学号、姓名、总分

显示，显示不及格的学生信息

修改，将及格的学生成绩增加5

删除，删除不及格的学生信息

结束，结束程序运行

Private Type xs

xh As String * 6

xm As String * 6

cj As Integer

End Type

Dim xs0 As xs

Private Sub command1_click() Dim I%

Open "D:\TT\T.DAT" For Random As #1 Len = Len(xs0)

For I = I To 5

xs0.xh = InputBox("XH")

xs0.xm = InputBox("XM")

xs0.cj = Val(InputBox("CJ"))

Put #1, , xs0

Next I

Close #1

End Sub

Private Sub command2_click() Dim I%

Open "D:\TT\T.DAT" For Random As #1 Len = Len(xs0)

For I = 1 To LOF(1) / Len(xs0) Get #1, , xs0

If xs0.cj < 60 Then

Print xs0.xh, xs0.xm, xs0.cj End If

Next I

Close #1

End Sub

Private Sub command3_click() Dim I%

Open "D:\TT\T.DAT" For Random As #1 Len = Len(xs0)

For I = 1 To LOF(1) / Len(xs0) Get #1, , xs0

If xs0.cj >= 60 Then

xs0.cj = xs0.cj + 5

Put #1, Seek(1) - 1, xs0 End If

Next I

Close #1

End Sub

Private Sub command4_click() Dim I%

If Dir("D:\TT\T.TMP") = "D:\TT\T.TMP" Then Kill "D:\TT\T.TMP"

Open "D:\TT\T.DAT" For Random As #1 Len = Len(xs0)

Open "D:\TT\T.TMP" For Random As #2 Len = Len(xs0)

For I = 1 To LOF(1) / Len(xs0) Get #1, , xs0

If xs0.cj >= 60 Then

Put #2, , xs0

End If

Next I

Close

Kill "D:\TT\T.DAT"

Name "D:\TT\T.TMP" As "D:\TT\T.DAT"

End Sub

Private Sub command5_click()

End

End Sub