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

我不知道呀

8组 A23 我不知道呀

无聊的疯子

作业传错附件了，重新传

A03:无聊的疯子

无聊的疯子－VBA第17课作业.rar (39.2 KB, 下载次数: 30)

2012-6-19 13:06 上传

点击文件名下载附件

jxncfxsf

Private Sub ComboBox1_Change()

Dim arr, ar(1 To 100)
Dim x, y As Integer
arr = Range("c5:e" & Range("d" & Rows.Count).End(xlUp).Row)
For x = 1 To UBound(arr)
If arr(x, 1) = ComboBox1.Value Then
    y = y + 1
    ar(y) = arr(x, 2)
   Do
    x = x + 1
    If arr(x, 1) = "" Then
    y = y + 1
    ar(y) = arr(x, 2)
    End If
   Loop Until arr(x, 1) <> "" Or x = UBound(arr)
   
    Exit For
    End If
    Next x
  ListBox1.List = ar
End Sub

Private Sub ComboBox1_Enter()
ComboBox1.DropDown
End Sub

Private Sub CommandButton1_Click()
Dim a As Integer
Dim str, st As String
a = Range("d" & Rows.Count).End(xlUp).Row
If ComboBox1.Value = "" Then MsgBox "请选择部门!": ComboBox1.SetFocus: Exit Sub
If ListBox1.ListIndex = -1 Then MsgBox "请选择员工": ListBox1.SetFocus: Exit Sub


If TextBox1.Value = "" Then MsgBox "请输入密码！": TextBox1.SetFocus: Exit Sub
str = ListBox1.List(ListBox1.ListIndex, 0)
st = Range("d5:d" & a).Find(str).Offset(, 1)
If TextBox1.Value = st Then
MsgBox "成功登录!"
Unload Me
Else
MsgBox "密码错误，请重新输入！"
TextBox1.SetFocus
End If
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim arr1, arr2
Dim m, n, i, q As Integer
m = Range("c" & Rows.Count).End(xlUp).Row
n = Application.CountA(Range("c5:c" & m))
ReDim arr1(1 To n)
Do
If Cells(5 + q, 3).Value <> "" Then
    i = i + 1
   arr1(i) = Cells(5 + q, 3)
   End If
   q = q + 1
Loop Until i = n
ComboBox1.List = arr1

End Sub

开心妙妙

• Private Sub UserForm_Initialize()
•     Dim x%, n%, i%
•     Dim arr()
•     i = Sheets("Sheet1").Range("C65536").End(xlUp).Row
•     ReDim arr(1 To 10)
•     For x = 5 To i
•         If Cells(x, 3) <> "" Then
•             n = n + 1
•             arr(n) = Cells(x, 3)
•         End If
•     Next x
•     部门.List = arr
• End Sub
• Private Sub 部门_Change()
•     Dim i%
•     Dim j%, j1%, n%
•     Dim arr()
•     j = Sheets("Sheet1").Range("C:C").Find(部门.Value).Row
•     j1 = j + 1
•     Do While Sheets("Sheet1").Range("C" & j1) = ""
•         j1 = j1 + 1
•     Loop
•     arr = Range("D" & j & ":D" & j1)
•     员工.List = arr
• End Sub
• Private Sub 登陆_Click()
•     Dim i%
•     i = Sheets("Sheet1").Range("D:D").Find(员工.Value).Row
•     If CStr(登陆密码.Value) = CStr(Sheets("Sheet1").Range("E" & i)) Then
•         MsgBox "登陆成功"
•     Else
•         MsgBox "密码错误,请重新输入"
•     End If
• End Sub
• Private Sub 退出_Click()
•     Unload UserForm1
• End Sub
  

VBA第17课窗体4.rar (52.24 KB, 下载次数: 12)

2012-6-19 10:24 上传

点击文件名下载附件

梅一枝

A05：梅一枝
大脑缺氧了。。。。连翻视频带找课件代码也没达到老师要求的效果。先提交作业。

Private Sub UserForm_Initialize()
    Dim x, j, i
    i = 1
    j = Range("e65536").End(xlUp).Row
    For x = 5 To j
        If Range("c" & x) <> "" Then
            ComboBox1.AddItem Range("c" & x)    '从课件中搬来的ComboBox1.RowSource = "sheet1!c5:e14"怎么用也不成功，不用这句下面人员显示还没法提取，纠结啊
        End If
        ComboBox1.ColumnCount = 1
      '  If Range("c" & i) = ComboBox1.Value Then
            '        ListBox1.value = ComboBox1.List(ComboBox1.ListIndex, 1) '这句折腾N天了，老提示无法获取list属性，突然明白复合框里没这列
            ' ListBox1.List (ListBox1.ListIndex) '加这句属性还不对，愁
       ' End If
    Next x
'    If ComboBox1.Value = "销售部" Then
'    ListBox1.List = Array("a", "b", "c", "d")
'    End If
End Sub


Private Sub CommandButton1_Click()
    Dim i As Integer
    For i = 5 To Range("d65536").End(xlUp).Row
        If Range("d" & i) = ListBox1.List(ListBox1.ListIndex) Then
            MsgBox "登陆成功"
        End If
    Next
    MsgBox "密码错误，请重新输入！"

End Sub
Private Sub CommandButton2_Click()
    Unload Me '就这个退出代码不费劲。
End Sub        

hactnet

交下作业 H组 h15-hactnet
Private Sub ComboBox1_Change()
          Dim arr
          If ComboBox1.ListIndex <> -1 Then '组合框没选取时listindex会返回-1
            If ComboBox1.Value = "销售部" Then
                arr = Range("D5:E8")
                ListBox1.List = arr
            ElseIf ComboBox1.Value = "客服部" Then
                arr = Range("D9:E11")
                ListBox1.List = arr
            ElseIf ComboBox1.Value = "财务部" Then
                arr = Range("D12:E14")
                ListBox1.List = arr
            
            End If
          End If
'Erase arr

End Sub

Private Sub CommandButton1_Click()
Dim sr As String
sr = ListBox1.List(ListBox1.ListIndex, 1)

'方法2
'Dim x As Integer
'For x = 0 To ListBox1.ListCount - 1
'If ListBox1.Selected(x) = True Then
'sr = ListBox1.List(x, 1)
'End If
'Next x

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

Private Sub UserForm_Initialize()
ComboBox1.List = Array("销售部", "客服部", "财务部")
End Sub

hactnet

忘了附件重交下作业 H组 h15-hactnet
Private Sub ComboBox1_Change()
          Dim arr
          If ComboBox1.ListIndex <> -1 Then '组合框没选取时listindex会返回-1
            If ComboBox1.Value = "销售部" Then
                arr = Range("D5:E8")
                ListBox1.List = arr
            ElseIf ComboBox1.Value = "客服部" Then
                arr = Range("D9:E11")
                ListBox1.List = arr
            ElseIf ComboBox1.Value = "财务部" Then
                arr = Range("D12:E14")
                ListBox1.List = arr
            
            End If
          End If
'Erase arr

End Sub

Private Sub CommandButton1_Click()
Dim sr As String
sr = ListBox1.List(ListBox1.ListIndex, 1)

'方法2
'Dim x As Integer
'For x = 0 To ListBox1.ListCount - 1
'If ListBox1.Selected(x) = True Then
'sr = ListBox1.List(x, 1)
'End If
'Next x

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

Private Sub UserForm_Initialize()
ComboBox1.List = Array("销售部", "客服部", "财务部")
End Sub

ls

补交作业

新增禁止关闭按钮
组合框自动打开


VBA第17课作业.rar (37.25 KB, 下载次数: 5)

2012-6-20 00:42 上传

点击文件名下载附件