Excel 2015VBA初级2班第2课A组作业上交贴（已开贴）

雪舞子

作业说明及要求：

1、根据第二课所讲的内容，按老师布置的作业，编写一段自认为精练的代码；
2、提交作业请注明论坛ID及学号。如：A01-麻花_；
3、作业请以代码方式提交，标清题号并所有题贴到一个代码标签中，无需提交附件。 不会使用标签可移步帖子：http://www.excelpx.com/thread-322284-1-1.html
4、代码题要求强制声明变量，代码缩进; 不会缩进可使用缩进小工具：http://www.excelpx.com/thread-366281-1-1.html
5、学习是自愿的，学成也是自已的；
6、我们的目标：超出他组，胜出我队。同学们加油！
7、作业截止时间：2015年11月10日18:00时

guofei0344

1. Sub QQ登陆框()
   
2.     Dim a As String, b As String
   
3. 123:
   
4.     a = Application.InputBox("请输入QQ号", "QQ登陆框", , , , , , 2)
   
5.     If a = "" Or a = "False" Then
   
6.         MsgBox "QQ号不能为空，请重新输入"
   
7.         GoTo 123
   
8.     ElseIf a = 9999 Then
   
9. 222:
   
10.         b = Application.InputBox("请输入密码", "QQ登陆框", , , , , , 2)
    
11.         Else
    
12.              MsgBox "没有此QQ号，请重新输入"
    
13.              GoTo 123
    
14.     End If
    
15.     If b = "" Then
    
16.         MsgBox "密码不能为空，请重新输入"
    
17.         GoTo 222
    
18.     ElseIf b = "123" Then
    
19.             MsgBox "登陆成功"
    
20.         Else
    
21.             MsgBox "密码错误，请重新输入"
    
22.             GoTo 222
    
23.     End If
    
24. End Sub
    

复制代码

1. 
   
2. Sub 相亲1()
   
3.     Dim a As String, b As String
   
4.     a = MsgBox("你有房吗？" & Chr(13) & "有=是" & Chr(13) & "没=否", vbYesNo, "相亲")
   
5.     b = MsgBox("你有车吗？" & Chr(13) & "有=是" & Chr(13) & "没=否", vbYesNo, "相亲")
   
6.     If a = vbYes And b = vbYes Then
   
7.         MsgBox "我们去领证"
   
8.     ElseIf a = vbYes Or b = vbYes Then
   
9.         MsgBox "让我考虑考虑"
   
10.     Else: MsgBox "不要再见面了"
    
11.     End If
    
12. End Sub
    

复制代码

guofei0344

1. 
   

复制代码

guofei0344

1. 
   

复制代码

麻花_

姓名：A01-麻花_

交作业啦，嘻嘻~。

第一题：相亲大战

1. Sub 相亲也就那么回事儿()
   
2.     MsgBox "【旁白】相亲大戏"
   
3.     MsgBox "男：美女，你愿意嫁给我吗？"
   
4.     Dim msg As VbMsgBoxResult
   
5.     msg = MsgBox("女：你有房吗？", vbQuestion + vbYesNo, "大战第一回合")
   
6.     If msg = vbYes Then
   
7.         A = MsgBox("女：你有车吗？", vbQuestion + vbYesNo, "大战第二回合")
   
8.         If A = vbYes Then
   
9.             MsgBox "女：民政局见~"
   
10.         Else
    
11.             MsgBox "女：在考虑考虑"
    
12.         End If
    
13.     Else
    
14.         A = MsgBox("女：你有车吗？", vbQuestion + vbYesNo, "大战第二回合")
    
15.         If A = vbYes Then
    
16.             MsgBox "女：在考虑一下"
    
17.         Else
    
18.             MsgBox "女：一边搓泥巴果果玩去~"
    
19.         End If
    
20.     End If
    
21. End Sub
    

复制代码

第二题：QQ登陆

1. Sub qq登陆()
   
2.     Dim A As Variant
   
3.     A = Application.InputBox("请输入QQ号码", "提示", 60, , , , , 2)
   
4.     If A <> 654321 Then
   
5.         MsgBox "QQ号码错误，请重新输入"
   
6.     Else
   
7.         b = Application.InputBox("请输入QQ密码", "提示", 60, , , , , 2)
   
8.         If b = 123456 Then
   
9.         MsgBox "登陆成功"
   
10.         Else
    
11.         MsgBox "登陆失败"
    
12.         End If
    
13.     End If
    
14. End Sub

复制代码

神隐汀渚

1、相亲记

1. Sub 相亲记()
   
2.     MsgBox "有房有车吗", vbQuestion, "请如实回答"
   
3.     MsgBox "没有", vbInformation, "男人淡定地说"
   
4.     MsgBox "有存款吗", vbQuestion, "请如实回答"
   
5.     MsgBox "也没有", vbInformation, "男人淡定地说"
   
6.     MsgBox "那你还相什么亲呀！！", vbQuestion, "女方起身欲走"
   
7.     MsgBox "我就管理几百人而已", vbInformation, "男人自豪地说"
   
8.     MsgBox "你是干嘛的啊", vbQuestion, "一脸羞涩地说"
   
9.     MsgBox "QQ群主呀", vbInformation, "一脸得意地说"
   
10.     MsgBox "有病", vbOKOnly, "一脸鄙视地说"
    
11.     MsgBox "哼，你以为只有这些呀", vbQuestion, "翘着二郎腿，点" & Chr(10) & " 燃一支香烟，优雅地说"
    
12.     MsgBox "那还有什么呀，死鬼~~~", vbQuestion, "面泛桃花地说"
    
13.     MsgBox "我微信也是群主", vbInformation, "深吸一口烟，吐了个烟圈"
    
14.     MsgBox "滚尼玛，大傻X", , "起身，端起剩余半杯橙汁怒泼在吐着烟圈的脸上，喝到"
    
15. End Sub

复制代码

2、QQ登陆

1. <font style="background-color: rgb(255, 255, 255);">Sub qq登陆()
   
2.     Dim i, j, K
   
3.     i = Application.InputBox("请输入QQ号码", "提醒", , , , , , 2)  '接收类型为数字
   
4. K:    If i = "" Then
   
5.         MsgBox "输入不能为空，请重新输入"
   
6.         i = Application.InputBox("请输入QQ号码", "提醒", , , , , , 2)
   
7.     GoTo K
   
8.         Else
   
9.             If i <> False Then
   
10.                 j = Application.InputBox("请输入QQ密码", "提醒", , , , , , 2) '接收类型为文本字符串
    
11.                 MsgBox "正在登陆中，请骚等", vbInformation, "友情提醒"
    
12.             Else
    
13.             Exit Sub
    
14.             End If
    
15.        End If
    
16. End Sub</font>

复制代码

woaivbayy

1. Option Explicit
   
2. Sub 输入函数()
   
3.   Dim msg As VbMsgBoxResult
   
4.   msg = MsgBox("看电影去?", vbQuestion + vbYesNo, "提示信息")
   
5.   If msg = vbYes Then
   
6.     MsgBox "去看九层妖塔吧？"
   
7.     MsgBox "异形更刺激一点!"
   
8.     MsgBox "好吧!"
   
9.   Else
   
10.     MsgBox "你想看什么?"
    
11.     msg = MsgBox("暮光之城！", vbQuestion + vbYesNo, "提示信息")
    
12.     If msg = vbYes Then
    
13.       MsgBox "我们去吧!"
    
14.     Else
    
15.       MsgBox "去屎！"
    
16.    
    
17.     End If
    
18.   End If
    
19.    
    
20. End Sub
    
21. 
    
22. Sub 输出函数()
    
23.   Dim I As Long, V As Long
    
24.   I = Application.InputBox("请输入账号", "提醒", , , , , 1)
    
25.   V = Application.InputBox("请输入密码", "提醒", , , , , 1)
    
26.   If I = 9999 And V = 123 Then
    
27.     MsgBox "登录正确!"
    
28.   Else
    
29.     MsgBox "登录失败!"
    
30.   End If
    
31. End Sub
    
32.    
    
33.    
    

复制代码

ZL在水一方

A12-ZL在水一方

作业1

1. Option Explicit
   
2. Sub QQ登陆()
   
3. Dim QqNum As String, QqKey As String
   
4. 1:
   
5. QqNum = Application.InputBox("请输入您的4位数QQ号码：", "提醒", "1111", , , , , 2)
   
6.     If QqNum = "9999" Then
   
7.         MsgBox "QQ号码正确！", vbOKOnly, "提醒"
   
8. 2:
   
9.         QqKey = Application.InputBox("请输入您的QQ密码：", "提醒", "****", , , , , 2)
   
10.         If QqKey = "1234" Then
    
11.             MsgBox "恭喜你登陆成功，欢迎回来！", vbOKOnly, "提示"
    
12.         Else
    
13.             MsgBox "密码输入错误，请重新输入", vbOKOnly + vbQuestion, "提示"
    
14.             GoTo 2
    
15.         End If
    
16.     Else
    
17.         MsgBox "QQ号码输入错误，请重新输入正确的QQ号码", vbOKOnly + vbInformation, "提醒"
    
18.         GoTo 1
    
19.     End If
    
20. End Sub

复制代码

作业2

1. Option Explicit
   
2. Sub 相亲场景()
   
3. Dim msg As VbMsgBoxResult
   
4. msg = MsgBox("有房吗？", vbYesNo, "女：")
   
5.     If msg = vbYes Then
   
6.         msg = MsgBox("那你有车吗？", vbYesNo, "女：")
   
7.         If msg = vbYes Then
   
8.             msg = MsgBox("有7位数以上存款吗？", vbYesNo, "女：")
   
9.             If msg = vbYes Then
   
10.                 MsgBox "我们领证结婚去吧！", , "女："
    
11.             Else
    
12.                 MsgBox "没存款，我们以后花什么呀？告辞！", , "女："
    
13.             End If
    
14.         Else
    
15.             MsgBox "没车，我怎么上班呢？我还有事，先走了哈", , "女："
    
16.         End If
    
17.     Else
    
18.         MsgBox "那我们住哪里呢？拜拜！", , "女："
    
19.     End If
    
20. End Sub

复制代码

开心妙妙

1. Sub 相亲对话() 'A03:开心妙妙
   
2.     Dim 张先生答 As String, 结果1 As String, 结果2 As String
   
3. 
   
4.     MsgBox "张先生，您有房吗?", , "李小姐提问"
   
5.     张先生答 = Application.InputBox("请输入：" & Chr(10) & Chr(10) & "【有】  或者 【没有】", "对话框", , , , , , 2)
   
6.     结果1 = 张先生答
   
7. 
   
8.     MsgBox "您有车吗?", , "李小姐提问"
   
9.     张先生答 = Application.InputBox("请输入：" & Chr(10) & Chr(10) & "【有】  或者 【没有】", "对话框", , , , , , 2)
   
10.     结果2 = 张先生答
    
11. 
    
12.     If 结果1 = "有" And 结果2 = "有" Then
    
13.         MsgBox "去民政局吧"
    
14.     ElseIf 结果1 = "有" Or 结果2 = "有" Then
    
15.         MsgBox "再考虑考虑吧!"
    
16.     ElseIf 结果1 = "" Or 结果1 = "False" Or 结果2 = "" Or 结果2 = "False" Then
    
17.         MsgBox "没有回答对话,资料缺省,退出程序"
    
18.         Exit Sub
    
19.     Else
    
20.         MsgBox "拜拜"
    
21.     End If
    
22. End Sub

复制代码

1. Sub QQ登陆() 'A03开心妙妙
   
2.     Dim QQID As String, QQPwd As String
   
3. 1:
   
4.     QQID = Application.InputBox("请输入QQ号", , , , , , , 2)
   
5.     If QQID = "False" Then Exit Sub
   
6.     If QQID = "" Then
   
7.         MsgBox "QQID不能为空,请重新输入", , "输入框"
   
8.         GoTo 1
   
9.     End If
   
10.     If QQID = "9999" Then
    
11. 2:
    
12.         QQPwd = Application.InputBox("请输入QQ密码", , , , , , , 2)
    
13.         If QQPwd = "False" Then Exit Sub
    
14.         If QQPwd = "" Then
    
15.             MsgBox "QQPwd不能为空,请重新输入", , "输入框"
    
16.             GoTo 2
    
17.         End If
    
18.     End If
    
19.     If QQID = "9999" And QQPwd = "123" Then
    
20.         MsgBox "登陆成功"
    
21.     Else
    
22.         MsgBox "登陆失败"
    
23.     End If
    
24. End Sub

复制代码

high12345

1. Option Explicit
   
2. 
   
3. Sub auth()
   
4. 
   
5.     Dim NameID As String
   
6.     Dim Password1 As String
   
7. 
   
8. reinputID:
   
9.     NameID = Application.InputBox("Please Input Your ID:", "ID", , , , , , 2)
   
10.     If NameID = "" Then
    
11.         MsgBox "ID Cannot Be Empty, Try Again."
    
12.         GoTo reinputID
    
13.     End If
    
14. 
    
15. reinputPassword:
    
16.     Password1 = Application.InputBox("Please Input Password:", "Password", , , , , , 2)
    
17.     If Password1 = "" Then
    
18.         MsgBox "Password Incorrect, please try again."
    
19.         GoTo reinputPassword
    
20.     End If
    
21. 
    
22.     If NameID <> "admin" Or Password1 <> "123" Then
    
23.         MsgBox "Log on failed."
    
24.     Else
    
25.         MsgBox "Welcome!"
    
26.     End If
    
27. End Sub
    

复制代码