Excel VBA 输入逐步提示/TextBox+ListBox

原创2023-08-07 10:57·VBA编程实战

​​​本文于2023年4月11日首发于本人同名公众号：Excel活学活用，更多文章敬请关注！

在前面我们分享过财务记账模板，其中录入科目的时候，我们采用数据验证的方法（Excel 公式函数/数据验证/动态下拉列表），这次，我们试试另一种方法，那就是VBA，通过TextBox+ListBox来实现：

首先，我们在“明细账”表中，点“开发工具“，点"设计模式"，插入Active控件，TextBox1、ListBox1，右键点击它们，属性，进行一些必要的Backcolor、Font等设置，不设置也没有关系，不过要把它们的Visible属性设置成False。

然后，我们再插入一个命令按钮，右击，属性，把Name改成CmdSwitch，Caption改成“下拉输入"。

接着，我们就进入Visual Basic编辑器，双击左边的sheet1(明细账),在代码窗口的最面定义模块级公共变量：

Dim arr()
Dim iRow As Integer

点选worksheet,SelectionChange事件：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
end sub

在其中输入代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Me.CmdSwitch.Caption = "控件输入" Then Exit Sub
    If Target.Row > 1 Then   '避开表头
       If Selection.Cells.count > 1 Then   '避开多重选区
            Me.TextBox1.Visible = False
            Me.ListBox1.Visible = False
            Exit Sub
        End If
        If Target.Column = 4 Then      '科目
            iRow = Sheets("科目").UsedRange.Rows.count
            arr = Sheets("科目").Range("C2:C" & iRow).Value
             With Me.TextBox1
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left + Target.Width
                .Height = Target.Height
                .Width = Target.Width + 1
                .Text = IIf(IsNull(Target.Text), "", Target.Text)
                .Activate
             End With
            With Me.ListBox1
                .Visible = True
                .Top = Me.TextBox1.Top + Me.TextBox1.Height
                .Left = Me.TextBox1.Left
                .Height = Target.Height * 5
                .Width = Target.Width
                If Me.TextBox1 = "" Then
                    .List = arr
                End If
            End With
        ElseIf Target.Column = 5 Then      '现金流量
            iRow = Sheets("XJLL").UsedRange.Rows.count
            arr = Sheets("XJLL").Range("C2:C" & iRow).Value
            If Left(Target.Offset(0, -1), 4) = "1001" Or Left(Target.Offset(0, -1), 4) = "1002" Then
                With Me.TextBox1
                    .Visible = True
                    .Top = Target.Top
                    .Left = Target.Left + Target.Width
                    .Height = Target.Height 
                    .Width = Target.Width
                    .Text = IIf(IsNull(Target.Text), "", Target.Text)
                    .Activate
                 End With
                With Me.ListBox1
                    .Visible = True
                    .Top = Me.TextBox1.Top + Me.TextBox1.Height
                    .Left = Me.TextBox1.Left
                    .Height = Target.Height * 5
                    .Width = Target.Width
                    If Me.TextBox1 = "" Then
                        .List = arr
                    End If
                  End With
            Else
                Me.TextBox1.Visible = False
                Me.ListBox1.Visible = False
            End If
           Else
            Me.TextBox1.Visible = False
            Me.ListBox1.Visible = False
          End If
    Else
        Me.TextBox1.Visible = False
        Me.ListBox1.Visible = False
    End If
 End Sub

再选中TextBox1,change事件，输入代码（可以通过双击控件进入）：

Private Sub TextBox1_Change()
    Dim arrSelect()
    Me.ListBox1.Clear
    For i = 1 To UBound(arr, 1)
        If InStr(arr(i, 1), Me.TextBox1) Then
            ReDim Preserve arrSelect(k)
            arrSelect(k) = arr(i, 1)
            k = k + 1
        End If
     Next
    With Me.ListBox1
        If k > 0 Then
            .List = arrSelect
        End If
    End With
End Sub

再选中listbox1,Dbclick事件（可以通过双击控件进入）：

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Selection = ListBox1
    Me.ListBox1.Visible = False
    Me.TextBox1.Visible = False
    Erase arr
End Sub

再选中CmdSwitch，click事件（可以通过双击控件进入）：

Private Sub CmdSwitch_Click()
    If Me.CmdSwitch.Caption = "下拉输入" Then
        Me.CmdSwitch.Caption = "控件输入"
        Me.TextBox1.Visible = False
        Me.ListBox1.Visible = False
        Me.CmdSwitch.BackColor = vbBlack
        Me.CmdSwitch.ForeColor = vbWhite
    Else
        Me.CmdSwitch.Caption = "下拉输入"
        Me.CmdSwitch.BackColor = RGB(128, 128, 128)
        Me.CmdSwitch.ForeColor = vbWhite
      End If
End Sub

简单解释一下代码：

工作表的SelectionChange事件：

当我们选中第4列（科目）、第5列（现金辅助项）的时候，就显示TextBox1、ListBox1，并根据当前选中的单元格（Target，Selection）的位置、高、宽来设置它们的位置。目前是显示在右侧、高度同Target，也可以把TextBox1覆盖在当前单元格上，稍微改下即可：

.Left = Target.Left

在代码开头，根据CmdSwitch.Caption来决定是否继续执行代码。当我们点击CmdSwitch的时候，它的Caption在“下拉输入“和”控件输入"之间切换，作为一个开关。

当点击一个科目单元格时，把科目列表存入数组arr，显示TextBox1和ListBox1，当单元格有内容时，把当前单元格的内容赋值给TextBox1，同时触发TextBox1的Change事件，当单元格内容为空时，则TextBox1亦为空，不触发它的Change事件，则把arr所有记录显示在ListBox1中。

当点击一个现金辅助项单元格时，根据左边对应科目来决定是否显示TextBox1和ListBox1。

TextBox1.Change事件：

根据TextBox1的内容，把arr中包含TextBox1的内容的记录提取出来存到数组arrSelect中，再把arrSelect的内容显示到ListBox1中。如果把TextBox1的内容删除，则会显示所有记录。

ListBox1.DbClick事件：

双击一条记录，则把该记录赋值给当前单元格，同时隐藏TextBox1、ListBox1。

好，今天我们就分享到这里，我们下期再会。

​​​​本文于2023年4月11日首发于本人同名公众号：Excel活学活用，更多文章敬请关注！

举报
评论 0
    热门：