Bộ bài giải chi tiết lập trình Visual basic

Private Sub Command1_Click()
Dim n As Integer
n = Val(InputBox("nhap so"))
If SoHoanHao(n) = True Then
MsgBox n & " la so hoan hao "
Else
MsgBox n & " khong phai la so hoan hao"
End If
End Sub
Private Function SoHoanHao(ByVal n As Integer) As Boolean
Dim i As Integer
Dim iTongUoc As Integer
iTongUoc = 1
For i = 2 To n \ 2 Step 1
If n Mod i = 0 Then
iTongUoc = iTongUoc + i
End If
Next
If iTongUoc = n Then
SoHoanHao = True
Else
SoHoanHao = False
End If
End Function

Private Sub Command2_Click()
MsgBox TanSoKyTu(InputBox("nhap chuoi"))
End Sub
Private Function TanSoKyTu(ByVal s As String) As String
Dim a(255) As Integer
Dim i As Integer

Dim c As String
Dim sKQ As String
'gán giá tri ban dau cho mang
For i = 0 To 255 Step 1
a(i) = 0
Next
'lay tung ky tu roi tang gia tri len 1
For i = 1 To Len(s) Step 1
a(Asc(Mid(s, i, 1))) = a(Asc(Mid(s, i, 1))) + 1
Next
'so sanh voi 0 va khoang trang de xuat ket qua
sKQ = ""
For i = 0 To 255 Step 1
If a(i) > 0 And Chr(i) <> Space(1) Then
sKQ = sKQ & "Ky tu " & Chr(i) & " xuat hien " & a(i) & " lan" & vbCrLf
End If
Next
TanSoKyTu = sKQ
End Function


Private Sub Command3_Click()
MsgBox DaoChuoi(InputBox("Nhap chuoi"))
End Sub
Private Function DaoChuoi(ByVal s As String) As String
Dim sKQ As String
Dim inWord As Boolean
Dim iDauTu As Integer, iCuoiTu As Integer
Dim i As Integer
sKQ = ""

inWord = False
For i = 1 To Len(s) Step 1
If Mid(s, i, 1) <> " " And inWord = False Then
iDauTu = i
inWord = True
ElseIf Mid(s, i, 1) = " " And inWord = True Then
iCuoiTu = i - 1
inWord = False
sKQ = " " & Mid(s, iDauTu, iCuoiTu - iDauTu + 1) & sKQ
End If
Next
If inWord = True Then
sKQ = " " & Mid(s, iDauTu) & sKQ
End If
sKQ = Mid(sKQ, 2)
DaoChuoi = sKQ
End Function
Private Sub Command4_Click()
Dim n As Integer
Dim a(0 To 100) As Integer
Dim i As Integer
n = InputBox("nhap n")
For i = 0 To n
a(i) = InputBox("a(" + Str(i) + ")")
Next i
MsgBox SoNhoNhi(a, n)
MsgBox SoAmLonNhat(a, n)
End Sub
Function SoNhoNhi(ByVal a As Variant, ByVal n As Integer) As Integer
'Tìm s? nh? nh?t. Sau ?ó tìm s? ??u tiên l?n h?n s? nh? nh?t

'=> Gán s? này là s? nh? nhì và quét h?t m?ng.
Dim SoNhoNhat As Integer, i As Integer
SoNhoNhat = a(0)
For i = 1 To n - 1 Step 1
If a(i) < SoNhoNhat Then
SoNhoNhat = a(i)
End If
Next
i=0
Do Until a(i) > SoNhoNhat
i=i+1


If i = n Then
Exit Do
End If
Loop
If i = n Then
SoNhoNhi = 0
Exit Function
End If
SoNhoNhi = a(i)
For i = i + 1 To n - 1 Step 1
If a(i) < SoNhoNhi And a(i) > SoNhoNhat Then
SoNhoNhi = a(i)
End If
Next
End Function
Function SoAmLonNhat(ByVal a As Variant, ByVal n As Integer) As Integer
Rem Tim vi tri so am dau tien

Rem Neu khong tim thay thi tra ve 0
Rem Neu tim thay thi goi so am dau tien la so am lon nhat
Rem Tim binh thuong
Dim iViTriSoAmDauTien As Integer, iSoAmMax As Integer
Dim bFlag As Boolean
Dim i As Integer, iKetQua As Integer
bFlag = False
For i = 0 To n - 1
If a(i) < 0 Then
iViTriSoAmDauTien = i
bFlag = True
Exit For
End If
Next
If bFlag = False Then
iKetQua = 0
Else
iSoAmMax = a(iViTriSoAmDauTien)
For i = iViTriSoAmDauTien + 1 To n - 1
If a(i) < 0 And a(i) > iSoAmMax Then
iSoAmMax = a(i)
End If
Next
iKetQua = iSoAmMax
End If
SoAmLonNhat = iKetQua
End Function
Private Sub Command5_Click()
MsgBox TongChuSo(Val(InputBox("Nhap n")))
End Sub

Function TongChuSo(ByVal n As Integer) As Integer
Dim iSoDu As Integer, s As Integer
s=0
Do While n > 0
iSoDu = n Mod 10
s = s + iSoDu


n = n \ 10
Loop
TongChuSo = s
End Function
Private Sub Command6_Click()
Dim s As String
t = False
t1 = False
s = InputBox("nhap chuoi")
MsgBox doithuong(s)
End Sub
Function doihoa(ByVal s As String) As String
Dim d As Long, i As Long, s1 As String, s2 As String, s3 As String
Dim k As Long
s = LCase(s)
'chuyen in hoa bat dau tu dau chuoi den tu ke cuoi
d = Len(s)
i = InStr(s, Space(1))
Do While (i < d) And (i <> 0)
s1 = Left(s, i - 1)
For k = 1 To Len(s1)
If Mid(s1, k, 1) <> Space(1) Then

s2 = s2 + Chr(Asc(Mid(s1, k, i)) - 32)
End If
Next k
s2 = s2 + Space(1) ' thêm khoang trang giua cac tu
s = Trim(Right(s, d - i))
d = Len(s)
i = InStr(s, " ")
Loop
'chuyen tu cuoi thanh in hoa
For k = 1 To Len(s)
If Mid(s, k, 1) <> Space(1) Then
s3 = s3 + Chr(Asc(Mid(s, k, 1)) - 32)
Else
s3 = s3
End If
Next k
doihoa = s2 + s3
End Function
Function doithuong(ByVal s As String) As String
s = UCase(s)
d = Len(s)
i = InStr(s, " ")
Do While (i < d) And (i <> 0)
s1 = Left(s, i - 1)
For k = 1 To Len(s1)
If Mid(s1, k, 1) <> Space(1) Then
s2 = s2 + Chr(Asc(Mid(s1, k, i)) + 32)
End If
Next k
s2 = s2 + " "

s = Trim(Right(s, d - i))
d = Len(s)
i = InStr(s, " ")
Loop


For k = 1 To Len(s)
If Mid(s, k, 1) <> Space(1) Then
s3 = s3 + Chr(Asc(Mid(s, k, 1)) + 32)
Else
s3 = s3
End If
Next k
doithuong = s2 + s3
End Function
Function DoiChuHoa(ByVal s As String) As String
Rem Doi chu cai dau tien thanh chu hoa, cac chu con lai
Rem thanh chu thuong cua mot tu
Dim r As String, c As String
r = LCase(s)
c = Mid(r, 1, 1)
r = Replace(r, c, UCase(c))
DoiChuHoa = r
End Function
Function ChuanHoaChuoi(ByVal s As String) As String
Rem Lay tung tu trong chuoi
Rem Doi chu cai dau tien thanh chu hoa, cac chu con lai
Rem thanh chu thuong
Rem Tao chuoi dau ra
Dim iViTriDau As Integer, iViTriCuoi As Integer

Dim r As String, c As String, w As String
Dim bInWord As Boolean
Dim i As Integer, L As Integer
L = Len(s)
bInWord = False
r = ""
For i = 1 To L
c = Mid(s, i, 1)
If c <> " " Then
If bInWord = False Then
bInWord = True
iViTriDau = i
End If
Else
If bInWord = True Then
bInWord = False
iViTriCuoi = i
w = Mid(s, iViTriDau, iViTriCuoi - iViTriDau)
w = DoiChuHoa(w)
r=r&w&""
End If
End If
Next
If bInWord = True Then
bInWord = False
iViTriCuoi = L + 1
w = Mid(s, iViTriDau, iViTriCuoi - iViTriDau)
w = DoiChuHoa(w)
r=r&w&""
End If

r = RTrim(r)
ChuanHoaChuoi = r


End Function
Private Sub Command7_Click()
MsgBox tongmasc(InputBox("nhap chuoi"))
End Sub
Function tongmasc(ByVal s As String) As Long
Dim i As Long
For i = 1 To Len(s)
tongmasc = tongmasc + Asc(Mid(s, i, 1))
Next i
End Function
Private Sub Command8_Click()
MsgBox caun(InputBox("nhap so"))
End Sub
Public Function caun(ByVal s As String) As String
Dim i As Long, c As String, d As String, e As String
s = Trim(s)
c = InputBox("nhap ky tu")
d = UCase(c)
e = LCase(c)
For i = 1 To Len(s)
If Mid(s, i, 1) = d Or Mid(s, i, 1) = e Then
dem = dem + 1
End If
Next i
caun = Str(dem)
End Function

Private Sub Command9_Click()
MsgBox caur(InputBox("nhap chuoi"))
End Sub
Public Function caur(ByVal s As String) As Long
Dim i As Long, c As String, d As String, e As String
d = Len(s)
i = InStr(s, Space(1))
Do While (i < d) And (i <> 1)
s1 = Left(s, i - 1)
For i = 1 To Len(s1)
If Mid(s1, i, 1) >= "0" And Mid(s1, i, 1) <= "9" Then
s2 = s2 + Mid(s1, i, 1)
End If
Next i
tong = tong + Val(s2)
s2 = ""
s = LTrim(Right(s, d - i)) + Space(1)
d = Len(s) + 1
i = InStr(s, Space(1))
Loop
caur = tong
End Function
Function chuanhoa(ByVal s As String) As String
Dim d As Long, i As Long, s1 As String
d = Len(s)
i = InStr(s, Space(1))
Do While (i < d) And (i <> 0)
s1 = Left(s, i - 1) + Space(1) + s1
s = Trim(Right(s, d - i))
d = Len(s)

i = InStr(s, Space(1))
Loop
chuanhoa = s1 & s
End Function
Private Sub Command10_Click()
MsgBox chutenrieng(InputBox("nhap chuoi"))
End Sub
Function chutenrieng(ByVal s As String) As String
Dim d As Long, i As Long, s1 As String
s = s + Space(1)
d = Len(s) + 1
i = InStr(s, Space(1))
Do While (i < d) And (i <> 1)
s1 = Left(s, i - 1)
s3 = UCase(Left(s1, 1))
For i = 2 To Len(s1)
s2 = s2 + LCase(Mid(s, i, 1))
Next i
s3 = s3 + s2
s4 = s4 + s3 + Space(1)
s2 = ""
s = Trim(Right(s, d - i)) + Space(1)
d = Len(s) + 1
i = InStr(s, Space(1))
Loop
chutenrieng = s4
End Function
Private Sub Command11_Click()

MsgBox demtu(InputBox("nhap chuoi"))
End Sub
Function demtu(ByVal s As String) As Long
Dim d As Long, i As Long, s1 As String
d = Len(s)
i = InStr(s, Space(1))
Do While (i < d) And (i <> 0)
dem = dem + 1
s = Trim(Right(s, d - i))
d = Len(s)
i = InStr(s, Space(1))
Loop
demtu = dem + 1
End Function
Private Sub Command12_Click()
MsgBox incactu(InputBox("nhap chuoi"))
End Sub
Function incactu(ByVal s As String) As String
Dim d As Long, i As Long, s1 As String
d = Len(s)
i = InStr(s, Space(1))
s = Trim(Right(s, d - i))
d = Len(s)
i = InStr(s, Space(1))
Do While (i < d) And (i <> 0)
s1 = s1 + Space(1) + Left(s, i - 1)
s = Trim(Right(s, d - i))
d = Len(s)
i = InStr(s, Space(1))
Loop

incactu = s1


End Function

unction KT(ByVal n As Integer) As Boolean
Dim i, tong As Integer
tong = 0
For i = 1 To n - 1
If n Mod i = 0 Then
tong = tong + i
End If
Next
If tong = n Then
KT = True
Else
KT = False
End If
End Function

Hàm in các chữ số là chính phương của N
Private Sub Command1_Click()
Dim n As Long
If Not IsNumeric(Text1.Text) Then
MsgBox "Nhap lai n"
Text1.Text = ""
Text1.SetFocus
Exit Sub
End If
n = Val(Text1.Text)

Label2.Caption = "Day cac so Chinh Phuong la: " & INSCP(n)
End Sub
Private Function KTCP(ByVal a As Long) As Boolean
Dim tam As Boolean, i As Long
i = -1
Do While i * i < a
i=i+1
Loop
If i * i = a Then
tam = True
Else
tam = False
End If
KTCP = tam
End Function
Private Function INSCP(ByVal n As Long) As String
Dim i As Long, k As Long, s As String
Do While n <> 0
k = n Mod 10
If KTCP(k) = True Then
s = s & " " & Str(k)
Else
s=s
End If


n = n \ 10
Loop
INSCP = s
End Function

Viết hàm tính tích các số không phải là
số chính phương từ 1 -> n (n>1)
rivate Sub Command1_Click()
Dim n As Long
If Not IsNumeric(Text1.Text) Then
MsgBox "Nhap lai n"
Text1.Text = ""
Text1.SetFocus
Exit Sub
End If
n = Val(Text1.Text)
Label2.Caption = Tinh(n)
--

End Sub
Private Function Tinh(ByRef n As Long)
As Long
Dim i As Long, j As Long, s As Long, b
As Long, c As Long
s=1
b=1


For i = 1 To n Step 1
b=b*i
Next i
For i = 1 To n Step 1
j = -1
Do While j * j < i

j=j+1
Loop
If j * j = i Then
s=s*i
Else
s=s
End If
Next i
c=b/s
Tinh = c
End Function
Viết hàm in n số chính phương đầu tiên
(n>1)
Private Sub Command1_Click()


Dim n As Long
If Not IsNumeric(Text1.Text) Then
MsgBox "Nhap lai n"
Text1.Text = ""
Text1.SetFocus
Exit Sub
End If
n = Val(Text1.Text)
Label2.Caption = "Day cac so Chinh
Phuong la: " & INSCP(n)
End Sub
Private Function INSCP(ByVal n As
Long) As String
Dim i As Long, j As Long, s As String,

dem As Long
Do While dem < n
i=i+1


j = -1
Do While j * j < i
j=j+1
Loop
If j * j = i Then
dem = dem + 1
s = s & " " & Str(i)
Else
dem = dem
s=s
End If
Loop
INSCP = s
End Function