统计VBA学习小组正式组的积分帖之作业上交贴（第22周）

冠军欧洲2010

说明:
统计帖每个学员只能跟帖回复一次，也就是在原来回复楼层的基础上点编缉，不要一个链接一层楼，否则不计算积分。
各小组学员上交作业时，一定要点击“我要参加”，并注明自己的新组编号和论坛ID，如果点击过“我要参加”但没有跟帖提交作业的，扣该学员5积分；如果跟帖提交了作业，但没有点“我要参加”的，不给予评分。

请各学员看清上面的说明，免得被扣了分分！
本帖为仅楼主可见帖，直接回复即可！
作业链接：
http://www.excelpx.com/thread-248433-1-1.html

w2001pf

{:011:}{:011:}作业没有链接？

冠军欧洲2010

w2001pf 发表于 2012-6-14 14:27
作业没有链接？

我也没有看到链接呢。。
我是先把作业上交帖给发出来了。
呵呵。

hrpotter

C12:hrpotter

1. Private Sub ComboBox1_Change()
   
2.     Dim ar()
   
3.     Dim i As Integer, k As Integer
   
4.     For i = 5 To Range("d65536").End(xlUp).Row
   
5.         If Cells(i, 3) = ComboBox1.Value Then
   
6.             Do
   
7.                 k = k + 1
   
8.                 ReDim Preserve ar(1 To k)
   
9.                 ar(k) = Cells(i, 4)
   
10.                 i = i + 1
    
11.             Loop Until Len(Cells(i, 3)) Or Len(Cells(i, 4)) = 0
    
12.             ListBox1.List = ar
    
13.             Exit Sub
    
14.         End If
    
15.     Next
    
16. End Sub
    
17. Private Sub CommandButton1_Click()
    
18.     Dim i As Integer
    
19.     If ListBox1.ListIndex = -1 Then MsgBox "请选择员工姓名！": Exit Sub
    
20.     For i = 5 To Range("d65536").End(xlUp).Row
    
21.         If Cells(i, 4) = ListBox1.List(ListBox1.ListIndex) And CStr(Cells(i, 5)) = TextBox1.Value Then
    
22.             MsgBox "登陆成功"
    
23.             Unload Me
    
24.             Exit Sub
    
25.         End If
    
26.     Next
    
27.     MsgBox "密码错误，请重新输入！"
    
28.     TextBox1.SetFocus
    
29.     TextBox1 = ""
    
30. End Sub
    
31. Private Sub CommandButton2_Click()
    
32.     Unload Me
    
33. End Sub
    
34. Private Sub UserForm_Initialize()
    
35.     Dim i As Integer
    
36.     For i = 5 To Range("c65536").End(xlUp).Row
    
37.         If Len(Cells(i, 3)) Then
    
38.             ComboBox1.AddItem Cells(i, 3)
    
39.         End If
    
40.     Next
    
41. End Sub

复制代码

C12-hrpotter-VBA第17课作业.rar (40.43 KB, 下载次数: 17)

2012-6-17 14:48 上传

点击文件名下载附件

yl_li

忘记文本框输入的值返回的是文本，折腾了半天，结果勉强正确。 VBA第17课作业-yl_li.rar (40.25 KB, 下载次数: 1)

2012-6-17 17:02 上传

点击文件名下载附件
Private Sub ComboBox1_Change()
Dim K As Integer
    If ComboBox1.ListIndex <> -1 Then
        If ListBox1.ListCount <> 0 Then
            For K = ListBox1.ListCount - 1 To 0 Step -1
                ListBox1.RemoveItem K
            Next K
        End If
        Select Case ComboBox1.Value
        Case "销售部"
            ListBox1.AddItem "A"
            ListBox1.AddItem "B"
            ListBox1.AddItem "C"
            ListBox1.AddItem "D"
        Case "客服部"
            ListBox1.AddItem "E"
            ListBox1.AddItem "F"
            ListBox1.AddItem "G"
        Case "财务部"
            ListBox1.AddItem "H"
            ListBox1.AddItem "I"
            ListBox1.AddItem "J"
        End Select
    End If
End Sub
Private Sub ComboBox1_Enter()
    ComboBox1.DropDown
End Sub
Private Sub CommandButton1_Click()
Dim x As Integer
    For x = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(x) = True Then
            If WorksheetFunction.VLookup(ListBox1.List(x, 0), Range("d5:e14"), 2, 0) = CInt(TextBox1.Value) Then
                MsgBox "登录成功"
            Else
                MsgBox "密码错误，请重新输入"
            End If
        End If
    Next x
End Sub
Private Sub CommandButton2_Click()
    Unload Me
End Sub
Private Sub UserForm_Initialize()
    ComboBox1.AddItem "销售部"
    ComboBox1.AddItem "客服部"
    ComboBox1.AddItem "财务部"
End Sub

wangfengren

B02:wangfengren上交第17讲窗体作业,见附件.

w2001pf

H07:w2001pf VBA第17课作业.rar (41.72 KB, 下载次数: 16)

2012-6-18 16:28 上传

点击文件名下载附件

dsjohn

写的时候感觉不是很好，感觉没有很好的使用按钮的属性

1982zyh

1. 
   
2. Private Sub ComboBox1_Change()
   
3. Dim arr
   
4. Dim n As Integer
   
5. For n = ListBox1.ListCount - 1 To 0 Step -1
   
6.     ListBox1.RemoveItem n
   
7. Next n
   
8. 
   
9. 
   
10. arr = Worksheets("Sheet1").Range("c5:e14").Value
    
11. For n = 1 To UBound(arr)
    
12. 
    
13. If arr(n, 1) = "" Then
    
14.      arr(n, 1) = arr(n - 1, 1)
    
15. End If
    
16. 
    
17. Next n
    
18. 
    
19. For n = 1 To UBound(arr)
    
20. If ComboBox1.Value = arr(n, 1) Then
    
21. ListBox1.AddItem arr(n, 2)
    
22. End If
    
23. Next n
    
24. 
    
25. End Sub
    
26. 
    
27. 
    
28. Private Sub CommandButton1_Click()
    
29. arr = Worksheets("Sheet1").Range("c5:e14").Value
    
30. Dim n As Integer, str As String, m As Integer, i As Integer
    
31. If ListBox1.ListIndex = -1 Or TextBox1.Value = "" Then Exit Sub
    
32. 
    
33. For i = 0 To ListBox1.ListCount - 1
    
34.     If ListBox1.Selected(i) Then _
    
35.         str = ListBox1.List(i)
    
36. 
    
37. Next i
    
38. 
    
39. m = TextBox1.Value
    
40. For n = 1 To UBound(arr)
    
41.     If str = arr(n, 2) Then
    
42.    
    
43.         If m = arr(n, 3) Then
    
44.    
    
45.                 MsgBox "登陆成功"
    
46.                 Exit For
    
47.         Else
    
48.                 MsgBox "密码错误，请重新输入"
    
49.                 TextBox1.Value = ""
    
50.                 Exit For
    
51.         End If
    
52.    
    
53.    
    
54.     End If
    
55. Next n
    
56. 
    
57. End Sub
    
58. 
    
59. 
    
60. Private Sub CommandButton2_Click()
    
61. Unload Me
    
62. End Sub
    
63. 
    
64. Private Sub UserForm_Initialize()
    
65. 
    
66. Dim arr, arr1(1 To 300)
    
67. 
    
68. Dim n As Integer
    
69. arr = Worksheets("Sheet1").Range("c5:e14").Value
    
70. 
    
71. 
    
72. x = 0
    
73. For n = 1 To UBound(arr)
    
74. If arr(n, 1) <> "" Then
    
75.     x = x + 1
    
76.     arr1(x) = arr(n, 1)
    
77. 
    
78. Else: arr(n, 1) = arr(n - 1, 1)
    
79. End If
    
80. Next n
    
81. For n = 1 To x
    
82. ComboBox1.AddItem arr1(n)
    
83. Next n
    
84. 
    
85. End Sub
    

复制代码

byhdch

A09byhdch VBA第19讲作业

1. 
   
2. Private Sub UserForm_Initialize()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />
   
3.     Dim arr, arr1(1 To 100, 1 To 1)
   
4.     Dim x As Integer
   
5.     Dim d As New Dictionary
   
6.     arr = Range("c5:e14")
   
7.     For x = 1 To UBound(arr)
   
8.         If arr(x, 1) = "" Then arr(x, 1) = arr(x - 1, 1)
   
9.         d(arr(x, 1)) = d.Count
   
10.         arr1(d.Count, 1) = arr(x, 1)
    
11.     Next x
    
12.     部门.List = arr1
    
13. End Sub
    
14. 
    
15. Private Sub 部门_Change()
    
16.     Dim arr, arr1(1 To 100, 1 To 1), arr2(1 To 100, 1 To 1), arr3(1 To 100, 1 To 1)
    
17.     Dim x, k, m, n As Integer
    
18.     Dim d As New Dictionary
    
19.     arr = Range("c5:d14")
    
20.     For x = 1 To UBound(arr)
    
21.         If arr(x, 1) = "" Then arr(x, 1) = arr(x - 1, 1)
    
22.         If arr(x, 1) = "销售部" Then
    
23.             k = k + 1
    
24.             arr1(k, 1) = arr(x, 2)
    
25.         ElseIf arr(x, 1) = "客服部" Then
    
26.             m = m + 1
    
27.             arr2(m, 1) = arr(x, 2)
    
28.         ElseIf arr(x, 1) = "财务部" Then
    
29.             n = n + 1
    
30.             arr3(n, 1) = arr(x, 2)
    
31.         End If
    
32.     Next x
    
33.     If 部门.Value = "销售部" Then ListBox1.List = arr1
    
34.     If 部门.Value = "客服部" Then ListBox1.List = arr2
    
35.     If 部门.Value = "财务部" Then ListBox1.List = arr3
    
36. End Sub
    
37. 
    
38. Private Sub 部门_Enter()
    
39.     部门.DropDown
    
40. End Sub
    
41. 
    
42. Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
43.     If Sheet1.Range("D:D").Find(ListBox1.Value).Row = Sheet1.Range("E:E").Find(TextBox1.Value).Row Then
    
44.         MsgBox "登录成功"
    
45.         Exit Sub
    
46.     Else
    
47.         MsgBox "密码错误，请重新输入"
    
48.     End If
    
49. End Sub
    
50. 
    
51. Private Sub CommandButton2_Click()
    
52.     Unload Userform1
    
53. End Sub

复制代码

A09byhdch VBA第19讲作业.rar (41.41 KB, 下载次数: 4)

2012-6-19 13:43 上传

点击文件名下载附件