如何实现指定条件 查询

sxy1372

最近在学习 查询功能，想着找个实例跟着操作一下，



我就增加了一个搜索框，并在原来的代码下面添加了新的 代码，结果运行只能看到第一列。


Private Sub UserForm_Initialize()
      TextBox1 = Format(Date, "yyyy-mm-dd")
      TextBox2 = Format(Date, "yyyy-mm-dd")
      '经办部门list
      Dim i, arr
      With Sheet3
            arr = .Range("c5", .Cells(6, .Cells(5, .Columns.Count).End(1).Column))
            For i = 1 To UBound(arr, 2)
                  ComboBox1.AddItem arr(1, i)
            Next
      End With
       '经办部门list
      With Sheet3
            arr = .Range("a5:z100" & .Range("z" & .Rows.Count).End(3).Row)
            For i = 2 To UBound(arr)
                  ComboBox2.AddItem arr(i, 3)
            Next
      End With    （我新增的）
     
End Sub




如何能实现  当第一个列表 选定的部门      下面经办人的列表只显示 这个部门下面的人。 求大佬 点化一下

cidanji

二级ComboBox，在一级ComboBox发生变化时添加items

1. Private Sub UserForm_Initialize()
   
2.       TextBox1 = Format(Date, "yyyy-mm-dd")
   
3.       TextBox2 = Format(Date, "yyyy-mm-dd")
   
4.       '经办部门list
   
5.       Dim i, arr
   
6.       With Sheet3
   
7.             arr = .Range("c5", .Cells(6, .Cells(5, .Columns.Count).End(1).Column))
   
8.             For i = 1 To UBound(arr, 2)
   
9.                   ComboBox1.AddItem arr(1, i)
   
10.             Next
    
11.       End With
    
12. '      '注销掉
    
13. '       '经办部门list
    
14. '      With Sheet3
    
15. '            arr = .Range("a5:z100" & .Range("z" & .Rows.Count).End(3).Row)
    
16. '            For i = 2 To UBound(arr)
    
17. '                  ComboBox2.AddItem arr(i, 3)
    
18. '            Next
    
19. '      End With
    
20.      
    
21. End Sub
    
22. Private Sub ComboBox1_Change()
    
23.       On Error Resume Next
    
24.       ComboBox2.Clear
    
25.       Dim n, m, i, arr
    
26.       With Sheet3
    
27.             n = Application.WorksheetFunction.Match(ComboBox1, .Rows("5:5"), 0)
    
28.             m = Application.WorksheetFunction.CountA(.Columns(n))
    
29.             arr = .Cells(5, n).Resize(m, 2)
    
30.             For i = 2 To UBound(arr)
    
31.                   ComboBox2.AddItem arr(i, 1)
    
32.             Next
    
33.       End With
    
34. End Sub

复制代码

cidanji

sxy1372

cidanji 发表于 2024-9-20 21:58

Option Explicit

Private Sub ComboBox1_Change()

End Sub

Private Sub ComboBox2_Change()

End Sub

'查询按钮
Private Sub CommandButton1_Click()
      If ComboBox1 = "" Then MsgBox "  报错：未选择部门", 48, " ": Exit Sub
      If DateValue(TextBox1) > DateValue(TextBox2) Then MsgBox "  报错：开始日期>结束日期", 48, " ": Exit Sub
      Dim i, arr, d
      
      With Sheet9
            .Unprotect
            .Range("c7:p" & .Rows.Count).ClearContents '清空查询表
            
            With Sheet2 '全部明细数组
                  arr = .Range("c6:p" & .Range("c" & .Rows.Count).End(3).Row)
            End With
            
            d = 7
            For i = 2 To UBound(arr)
                  If arr(i, 1) >= DateValue(TextBox1) And arr(i, 1) <= DateValue(TextBox2) And arr(i, 10) = ComboBox1 Then
                        .Cells(d, 3).Resize(1, UBound(arr, 2)) = Application.WorksheetFunction.Index(arr, i)
                        d = d + 1
                  End If
            Next
            
            .Range("J4") = "查询条件：" & ComboBox1 & "，" & TextBox1 & "至" & TextBox2 & ComboBox2
            
            .Protect
      End With
      
      Unload Me
End Sub


Private Sub Label1_Click()

End Sub

Private Sub Label2_Click()

End Sub

'开始日期TextBox1_MouseDown
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
      QYrl.Show
      If IsDate(QYrl.dts) Then TextBox1 = Format(QYrl.dts, "yyyy-mm-dd")
      Unload QYrl
End Sub


'结束日期TextBox2_MouseDown
Private Sub TextBox2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
      QYrl.Show
      If IsDate(QYrl.dts) Then TextBox2 = Format(QYrl.dts, "yyyy-mm-dd")
      Unload QYrl
End Sub

Private Sub UserForm_Initialize()
      TextBox1 = Format(Date, "yyyy-mm-dd")
      TextBox2 = Format(Date, "yyyy-mm-dd")
      '经办部门list
      Dim i, arr
      With Sheet3
            arr = .Range("c5", .Cells(6, .Cells(5, .Columns.Count).End(1).Column))
            For i = 1 To UBound(arr, 2)
                  ComboBox1.AddItem arr(1, i)
            Next
      End With
Private Sub ComboBox1_Change()
      On Error Resume Next
      ComboBox2.Clear
      Dim n, m, i, arr
      With Sheet3
            n = Application.WorksheetFunction.Match(ComboBox1, .Rows("5:5"), 0)
            m = Application.WorksheetFunction.CountA(.Columns(n))
            arr = .Cells(5, n).Resize(m, 2)
            For i = 2 To UBound(arr)
                  ComboBox2.AddItem arr(i, 1)
            Next
      End With
     
End Sub
这是整个窗口的代码，我添加了你指导的，出现''发现二义性名称'' 错误

sxy1372

cidanji 发表于 2024-9-20 21:58

添加后出现

sxy1372

1. Option Explicit
   
2. 
   
3. Private Sub ComboBox1_Change()
   
4. 
   
5. End Sub
   
6. 
   
7. 
   
8. Private Sub ComboBox2_Change()
   
9. 
   
10. End Sub
    
11. 
    
12. '查询按钮
    
13. Private Sub CommandButton1_Click()
    
14.       If ComboBox1 = "" Then MsgBox "  报错：未选择部门", 48, " ": Exit Sub
    
15.       If DateValue(TextBox1) > DateValue(TextBox2) Then MsgBox "  报错：开始日期>结束日期", 48, " ": Exit Sub
    
16.       Dim i, arr, d
    
17.       
    
18.       With Sheet9
    
19.             .Unprotect
    
20.             .Range("c7:p" & .Rows.Count).ClearContents '清空查询表
    
21.             
    
22.             With Sheet2 '全部明细数组
    
23.                   arr = .Range("c6:p" & .Range("c" & .Rows.Count).End(3).Row)
    
24.             End With
    
25.             
    
26.             d = 7
    
27.             For i = 2 To UBound(arr)
    
28.                   If arr(i, 1) >= DateValue(TextBox1) And arr(i, 1) <= DateValue(TextBox2) And arr(i, 10) = ComboBox1 Then
    
29.                         .Cells(d, 3).Resize(1, UBound(arr, 2)) = Application.WorksheetFunction.Index(arr, i)
    
30.                         d = d + 1
    
31.                   End If
    
32.             Next
    
33.             
    
34.             .Range("J4") = "查询条件：" & ComboBox1 & "，" & TextBox1 & "至" & TextBox2 & ComboBox2
    
35.             
    
36.             .Protect
    
37.       End With
    
38.       
    
39.       Unload Me
    
40. End Sub
    
41. 
    
42. 
    
43. Private Sub Label1_Click()
    
44. 
    
45. End Sub
    
46. 
    
47. Private Sub Label2_Click()
    
48. 
    
49. End Sub
    
50. 
    
51. '开始日期TextBox1_MouseDown
    
52. Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
53.       QYrl.Show
    
54.       If IsDate(QYrl.dts) Then TextBox1 = Format(QYrl.dts, "yyyy-mm-dd")
    
55.       Unload QYrl
    
56. End Sub
    
57. 
    
58. 
    
59. '结束日期TextBox2_MouseDown
    
60. Private Sub TextBox2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
61.       QYrl.Show
    
62.       If IsDate(QYrl.dts) Then TextBox2 = Format(QYrl.dts, "yyyy-mm-dd")
    
63.       Unload QYrl
    
64. End Sub
    
65. 
    
66. Private Sub UserForm_Initialize()
    
67.       TextBox1 = Format(Date, "yyyy-mm-dd")
    
68.       TextBox2 = Format(Date, "yyyy-mm-dd")
    
69.       '经办部门list
    
70.       Dim i, arr
    
71.       With Sheet3
    
72.             arr = .Range("c5", .Cells(6, .Cells(5, .Columns.Count).End(1).Column))
    
73.             For i = 1 To UBound(arr, 2)
    
74.                   ComboBox1.AddItem arr(1, i)
    
75.             Next
    
76.       End With
    
77. End Sub
    
78. Private Sub ComboBox1_Change()
    
79.       On Error Resume Next
    
80.       ComboBox2.Clear
    
81.       Dim n, m, i, arr
    
82.       With Sheet3
    
83.             n = Application.WorksheetFunction.Match(ComboBox1, .Rows("5:5"), 0)
    
84.             m = Application.WorksheetFunction.CountA(.Columns(n))
    
85.             arr = .Cells(5, n).Resize(m, 2)
    
86.             For i = 2 To UBound(arr)
    
87.                   ComboBox2.AddItem arr(i, 1)
    
88.             Next
    
89.       End With
    
90. 
    
91.      
    
92. End Sub

复制代码

cidanji

这些空过程去掉啊

sxy1372

cidanji 发表于 2024-9-21 12:12
这些空过程去掉啊

谢谢，太感谢你了