在昨天分享的最后，我们说，“动态设置单元格数据验证的方法，也可以改为使用【复合框ComboBox控件】“，今天我们不防就把“付款申请单“中的几个数据验证的下拉列表改为用ComboBox来实现。1、在工作表“付款申请单”上添加一个ComboBox控件，我们添加Active控件，不要添加表单控件。2、模仿SetDataValidation过程，我们增加一个SetComboBox过程，当选中指定单元格时，把ComboBox的大小、位置调整为与目标单元格一致，同时给ComboBox添加List：Sub SetComboBox(rng As Range, arr()) With Me.ComboBox1 .Clear .Visible = True .Left = rng.Left .Top = rng.Top .Height = rng.Height .Width = rng.Width .List = arr End WithEnd Sub
3、设置comboBox的事件，既能选择项目录入，也可以直接输入内容：Private Sub ComboBox1_Click() '//点选一个项目，赋值给单元格，隐藏控件 Selection = Me.ComboBox1 Me.ComboBox1.Visible = FalseEnd Sub
Private Sub ComboBox1_Change() '//输入内容同步到目标单元格 If Me.ComboBox1 <> "" Then Selection = Me.ComboBox1 End IfEnd Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) '//当我们在combobox的文本框输入内容，按回车结束输入，隐藏控件 If KeyCode = vbKeyReturn Then Me.ComboBox1.Visible = False End IfEnd Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '//2024-4-24修改 On Error Resume Next Dim iRow As Integer, iCol As Integer Dim iWidth As Single '//结算方式、付款单号、款项说明、内容说明单元格添加ComboBox下拉列表控件 Dim ws As Worksheet, currRow As Integer, lastRow As Integer Dim arr(), dic As Object, dkey As String Set dic = CreateObject("Scripting.Dictionary") dbs = ThisWorkbook.FullName tbl = "[数据$]" dkey = Target.Address currRow = Target.Row If dkey = clsRG.结算方式.MergeArea.Address Then sql = "select distinct 结算方式 from " & tbl & " where isnull(结算方式)=false" dic(dkey) = 1 ElseIf dkey = clsRG.付款单号.MergeArea.Address Then sql = "select distinct 付款单号 from " & tbl & " where isnull(付款单号)=false order by 付款单号 DESC" dic(dkey) = 1 ElseIf dkey = clsRG.款项用途.MergeArea.Address Then sql = "select distinct 款项用途 from " & tbl & " where isnull(款项用途)=false" dic(dkey) = 1 ElseIf dkey = clsRG.内容说明.MergeArea.Address Then sql = "select distinct 内容说明 from " & tbl & " where isnull(内容说明)=false" dic(dkey) = 1 End If If dic.exists(dkey) Then' Target.Validation.Delete On Error Resume Next arr = clsDQ.getData(sql) On Error GoTo 0 If Not IsArrEmpty(arr) Then 'Call SetDataValidation(arr, Target) arr = Application.WorksheetFunction.Transpose(arr) Call SetComboBox(Target, arr) End If Else Me.ComboBox1.Visible = False' Me.ComboBox1.Clear End If If Target.Address = clsRG.收款单位.MergeArea.Address Then iWidth = Range("B3:H3").Width With Me.TextBox1 .Visible = True .Top = Target.Top + Target.Height .Left = Target.Left .Width = Target.Width .Height = Target.Height With Me.ListBox1 .Visible = True .Top = Me.TextBox1.Top + Me.TextBox1.Height .Left = Me.TextBox1.Left .Width = iWidth .ColumnCount = 3 If IsArrEmpty(arr) Then arr = getList End If iRow = UBound(arr) iCol = UBound(arr, 2) ReDim arrtemp(0 To iCol, 0 To iRow) For i = 0 To iCol For j = 0 To iRow arrtemp(i, j) = arr(j, i) Next Next .List = arrtemp .Height = 30 + (.ListCount - 1) * 12 If .Height > 100 Then .Height = 100 End If End With End With Else With Me.TextBox1 .Visible = False .Text = "" End With Me.ListBox1.Visible = False End IfEnd Sub
主要把跟数据验证有关的代码删除或注释掉，增加设置ComboBox控件的代码，基本逻辑没有变，就是把添加数据验证改为显示ComboBox控件。查询数据的SQL语句也作了修改，增加了Where语句，剔除Null值，原因是数组有Null值就用不了Transpose函数。
|
