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

冠军欧洲2010 发表于 2012-6-13 19:39

本帖最后由冠军欧洲2010 于 2012-6-21 20:01 编辑

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

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

w2001pf 发表于 2012-6-14 14:27

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

冠军欧洲2010 发表于 2012-6-14 15:10

w2001pf 发表于 2012-6-14 14:27 static/image/common/back.gif
作业没有链接？

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

hrpotter 发表于 2012-6-17 14:48

C12:hrpotterPrivate Sub ComboBox1_Change()
Dim ar()
Dim i As Integer, k As Integer
For i = 5 To Range("d65536").End(xlUp).Row
   If Cells(i, 3) = ComboBox1.Value Then
         Do
            k = k + 1
            ReDim Preserve ar(1 To k)
            ar(k) = Cells(i, 4)
            i = i + 1
         Loop Until Len(Cells(i, 3)) Or Len(Cells(i, 4)) = 0
         ListBox1.List = ar
         Exit Sub
   End If
Next
End Sub
Private Sub CommandButton1_Click()
Dim i As Integer
If ListBox1.ListIndex = -1 Then MsgBox "请选择员工姓名！": Exit Sub
For i = 5 To Range("d65536").End(xlUp).Row
   If Cells(i, 4) = ListBox1.List(ListBox1.ListIndex) And CStr(Cells(i, 5)) = TextBox1.Value Then
         MsgBox "登陆成功"
         Unload Me
         Exit Sub
   End If
Next
MsgBox "密码错误，请重新输入！"
TextBox1.SetFocus
TextBox1 = ""
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer
For i = 5 To Range("c65536").End(xlUp).Row
   If Len(Cells(i, 3)) Then
         ComboBox1.AddItem Cells(i, 3)
   End If
Next
End Sub

yl_li 发表于 2012-6-17 17:01

忘记文本框输入的值返回的是文本，折腾了半天，结果勉强正确。
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 发表于 2012-6-17 20:50

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

w2001pf 发表于 2012-6-18 16:28

H07:w2001pf

dsjohn 发表于 2012-6-18 19:49

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

1982zyh 发表于 2012-6-18 23:15

Private Sub ComboBox1_Change()
Dim arr
Dim n As Integer
For n = ListBox1.ListCount - 1 To 0 Step -1
ListBox1.RemoveItem n
Next n

arr = Worksheets("Sheet1").Range("c5:e14").Value
For n = 1 To UBound(arr)

If arr(n, 1) = "" Then
arr(n, 1) = arr(n - 1, 1)
End If

Next n

For n = 1 To UBound(arr)
If ComboBox1.Value = arr(n, 1) Then
ListBox1.AddItem arr(n, 2)
End If
Next n

End Sub

Private Sub CommandButton1_Click()
arr = Worksheets("Sheet1").Range("c5:e14").Value
Dim n As Integer, str As String, m As Integer, i As Integer
If ListBox1.ListIndex = -1 Or TextBox1.Value = "" Then Exit Sub

For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then _
   str = ListBox1.List(i)

Next i

m = TextBox1.Value
For n = 1 To UBound(arr)
If str = arr(n, 2) Then

   If m = arr(n, 3) Then

            MsgBox "登陆成功"
            Exit For
   Else
            MsgBox "密码错误，请重新输入"
            TextBox1.Value = ""
            Exit For
   End If

End If
Next n

End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()

Dim arr, arr1(1 To 300)

Dim n As Integer
arr = Worksheets("Sheet1").Range("c5:e14").Value

x = 0
For n = 1 To UBound(arr)
If arr(n, 1) <> "" Then
x = x + 1
arr1(x) = arr(n, 1)

Else: arr(n, 1) = arr(n - 1, 1)
End If
Next n
For n = 1 To x
ComboBox1.AddItem arr1(n)
Next n

End Sub

byhdch 发表于 2012-6-19 01:00

本帖最后由 byhdch 于 2012-6-19 13:43 编辑

A09byhdch VBA第19讲作业

Private Sub UserForm_Initialize()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />
Dim arr, arr1(1 To 100, 1 To 1)
Dim x As Integer
Dim d As New Dictionary
arr = Range("c5:e14")
For x = 1 To UBound(arr)
   If arr(x, 1) = "" Then arr(x, 1) = arr(x - 1, 1)
   d(arr(x, 1)) = d.Count
   arr1(d.Count, 1) = arr(x, 1)
Next x
部门.List = arr1
End Sub

Private Sub 部门_Change()
Dim arr, arr1(1 To 100, 1 To 1), arr2(1 To 100, 1 To 1), arr3(1 To 100, 1 To 1)
Dim x, k, m, n As Integer
Dim d As New Dictionary
arr = Range("c5:d14")
For x = 1 To UBound(arr)
   If arr(x, 1) = "" Then arr(x, 1) = arr(x - 1, 1)
   If arr(x, 1) = "销售部" Then
         k = k + 1
         arr1(k, 1) = arr(x, 2)
   ElseIf arr(x, 1) = "客服部" Then
         m = m + 1
         arr2(m, 1) = arr(x, 2)
   ElseIf arr(x, 1) = "财务部" Then
         n = n + 1
         arr3(n, 1) = arr(x, 2)
   End If
Next x
If 部门.Value = "销售部" Then ListBox1.List = arr1
If 部门.Value = "客服部" Then ListBox1.List = arr2
If 部门.Value = "财务部" Then ListBox1.List = arr3
End Sub

Private Sub 部门_Enter()
部门.DropDown
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Sheet1.Range("D:D").Find(ListBox1.Value).Row = Sheet1.Range("E:E").Find(TextBox1.Value).Row Then
   MsgBox "登录成功"
   Exit Sub
Else
   MsgBox "密码错误，请重新输入"
End If
End Sub

Private Sub CommandButton2_Click()
Unload Userform1
End Sub

页: [1] 2

Excel精英培训网's Archiver

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