loading...
کامپیوتر و دنیای اطلاعات روز
اسلمی بازدید : 47 یکشنبه 11 اسفند 1392 نظرات (0)

ده عدد را گرفته تعیین کند کدام زوج و کدام فرد است.

Private Sub Command13_Click() '16

Cls

Dim i As Integer, n As Integer

For i = 1 To 10

n = InputBox("Enter the num")

Print n; Tab(10); IIf(n Mod 2 = 0, "Even", "Odd")

Next

End Sub

 

 

2  مجموع اعداد زوج و فرد 0 تا 100 را محاسبه کرده و جداگانه چاپ کند.

Private Sub Command14_Click()

Dim i As Integer, s As Integer

For i = 0 To 100 Step 2

s = s + i

Next

MsgBox Prompt:=s, Title:="Events"

s = 0

For i = 1 To 100 Step 2

s = s + i

Next

MsgBox Prompt:=s, Title:="Odds"

End Sub

 

   3  20 عدد را خوانده، بزرگترین و کوچکترین آنها را نمایش دهد.

Private Sub Command15_Click()

Dim min As Integer, max As Integer, n As Integer, i As Integer

For i = 1 To 20

n = InputBox("Enter a num")

If i = 1 Then min = n

If n > max Then max = n

If n < min Then min = n

Next

MsgBox "Max: " & max & " Min: " & min

End Sub

4   برنامه ای بنویسید که عدد چها رقمی فاقد صفر را به همراه تعداد کل آنها نمایش دهد.

Private Sub Command16_Click()

Cls

Dim i As Integer, b As Boolean, t As Integer, c As Integer

For i = 10 To 99

b = True

t = i

Do While t > 0 And b

If t Mod 10 = 0 Then b = False

t = t 10

Loop

If b Then

c = c + 1

Print i;

If c Mod 20 = 0 Then Print

End If

Next

MsgBox "Total: " & c

End Sub

 

5   برنامه ای بنویسید که یک عدد را خوانده، اول بودن آن را تعیین نماید و پیغام مناسبی چاپ کند.

 

Private Sub Command6_Click()

Cls

Dim i As Integer, n As Integer, t As Boolean

n = InputBox("Enter a num:")

t = True

i = 2

Do While i <= n / 2 And t

If n Mod i = 0 Then t = False

i = i + 1

Loop

If t Then

Print "Prim"

Else: Print "not prim"

End If

End sub

  6برنامه ای بنویسید که یک عدد را گرفته و فاکتوریل آن را محاسبه و چاپ کند.

 

Private Sub Command19_Click()

Dim i As Integer, f&

f = 1

For i = 1 To InputBox("Enter a number to reach its single factorial:")

f = f * i

Next

MsgBox f

End Sub

 

 

   7برنامه ای بنویسید که برای اعداد 1 تا 10 مجموع اعداد از یک تا آن عدد را نمایش دهد.


 

Private Sub Command20_Click()

Cls

Dim i As Integer, j As Integer, s As Integer

For i = 1 To 10

s = 0

For j = 1 To i

s = s + j

Next

Print s;

Next

End Sub

   8 برنامه ای بنویسید که عدد N را خوانده و مجموع ارقام آن را نشان دهد.

 

Private Sub Command21_Click() '25

Dim n As Integer, s As Integer

n = InputBox("Enter the num:")

While n > 0

s = s + n Mod 10

n = n 10

Wend

MsgBox s

 

 

 

    9برنامه ای بنویسید که یک عدد صحیح مثبت را خوانده جذر آن را نمایش دهد.

 

Private Sub Command23_Click()

Cls

Dim n As Integer, i As Integer, s As Integer, c As Integer

n = InputBox("Enter a natural number to get its square root (without sqr() function)")

i = 1

While s < n

s = s + i

i = i + 2

c = c + 1

Wend

If s > n Then

Print "Near "; (s / c) - 1

Else: Print "Really "; s / c

End If

'Or use n ^ 0.5 equation

End Sub

 

    10برنامه ای بنویسید که یک عدد حد اقل چهارقمی مثبت را خوانده، مغلوب آن را نمایش دهد.

 

Private Sub Command22_Click()

Cls

Dim n As Integer, i As Integer

n = InputBox("Enter the num:")

While n > 0

i = n Mod 10

Print CStr(i);

n = n 10

Wend

End Sub

 

     11برنامه ای بنویسید که 20 جمله اول سری فیبوناچی را نمایش دهد.


 

Private Sub Command24_Click()

Cls

Dim a As Integer, b As Integer, c As Integer, i As Integer

a = 1

For i = 1 To InputBox("Enter number of fibonacci series you want to make", , 20)

c = a + b

Print c

a = b

b = c

Next

End Sub

 

   12برنامه ای بنویسید که دو عدد صحیح از ورودی خوانده و عمل ضرب را بدون استفاده از عملگر ضرب محاسبه و نمایش دهد.

 

Private Sub Command25_Click()

Dim a As Integer, b As Integer, i As Integer, m As Integer

a = InputBox("Enter first num")

b = InputBox("Enter second num")

For i = 1 To b

m = m + a

Next

MsgBox a & " * " & b & " = " & m

End Sub

 

 

 

     13برنامه ای بنویسید که رشته ای را از ورودی دریافت کرده و تعداد حروف بزرگ و کوچک آن را نمایش دهد بصورت مجزا.


 

Private Sub Command1_Click()

Cls

Dim s As String

s = InputBox("")

For i = 1 To Len(s)

Select Case Mid(s, i, 1)

Case "A" To "Z"

u = u + 1

Case "a" To "z"

l = l + 1

End Select

Next

Print "horuf kuchak"; l

Print "horufe bozorg"; u

End Sub

     14برنامه ای بنویسید که رشته ای را از ورودی دریافت کرده و تعیین کند که آیا رشته از هردو طرف که در نظر گرفته شود یکسان است یا خیر؟

 

مثل؟ bacb?    یا    deed

Private Sub Command2_Click()

Cls

Dim t As String

t = InputBox("Enter string")

If StrReverse(t) = t Then

Print "YES"

Else: Print "NO"

End If

End Sub

 

 

   15برنامه ای بنویسید که بدون استفاده از تابع Replace، کار این تابع را شبیه سازی کند.


 

Private Sub Command3_Click()

Cls

Dim s As Integer, f As Integer, r As Integer, p1 As Integer, p2 As Integer, i As Integer

s = InputBox("Enter string")

f = InputBox("Find")

r = InputBox("Replace with")

Do Until InStr(1, s, f) = 0

i = InStr(1, s, f)

p1 = Mid(s, 1, i - 1)

p2 = Mid(s, i + Len(f))

s = p1 + r + p2

Loop

Print s

End Sub

 

   16برنامه ای بنویسید که رشته ای را از ورودی دریافت کند و مجموع ارقام نویسه ای موجود در رشته را محاسبه نماید و نمایش دهد. 
     

Private Sub Command5_Click()

Cls

Dim t As String, i As Integer, s As Integer, p As String

t = InputBox("Enter string")

For i = 1 To Len(t)

p = Mid(t, i, 1)

If IsNumeric(p) Then s = s + p

Next

Print s

End Sub

 

   17برنامه ای بنویسید که حاصل عبارت زیر را تا 10 جمله حساب کند:

 

Private Sub Command1_Click()

Dim i As Integer, a As Single

a = 1

For i = 1 To 9

a = a + i / (i + 1)

Next

Print a

End Sub

 

    18برنمه ای بنویسید که 50 اسم را از ورودی دریافت و تعداد افرادی را ه نامشان mohsen است، نمایش دهد.

 

Private Sub Command1_Click()

For i = 1 To 10

If LCase(InputBox("Enter a name: " & i)) = "mohsen" Then a = a + 1

Next

Print a

End Sub

 

 

ارسال نظر برای این مطلب

کد امنیتی رفرش
اطلاعات کاربری
  • فراموشی رمز عبور؟
  • آمار سایت
  • کل مطالب : 20
  • کل نظرات : 6
  • افراد آنلاین : 1
  • تعداد اعضا : 4
  • آی پی امروز : 18
  • آی پی دیروز : 4
  • بازدید امروز : 22
  • باردید دیروز : 6
  • گوگل امروز : 7
  • گوگل دیروز : 4
  • بازدید هفته : 86
  • بازدید ماه : 59
  • بازدید سال : 1,255
  • بازدید کلی : 8,893
  • کدهای اختصاصی