在前面我们分享过财务记账模板,其中录入科目的时候,我们采用数据验证的方法(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。
技术交流,软件开发,欢迎微信沟通: