Textbox和ListBox构造树形结构快速录入数据

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call UFItemsSelect.ClearListboxValue
If Target.Column = 14 Then
If Target.Count > 1 Then Exit Sub
Cancel = True
Dim arOneLevelSubAfterDistinct() ' arOneLevelSubAfterDistinct
Dim n As Long
With UFItemsSelect
.ListBox1_OneLevelSub.Clear
arOneLevelSubAfterDistinct = Sheet10.Range("A2:A8")
For n = 1 To UBound(arOneLevelSubAfterDistinct)
.ListBox1_OneLevelSub.AddItem arOneLevelSubAfterDistinct(n, 1)
Next
End With
UFItemsSelect.Show 1
End If
End Sub

 

 

Public Sub CommandButton1_SelectItem_Click()
Dim oneLevelSub_ As String
Dim TwoLevelSub_ As String
Dim ThreeLevelSub_ As String
Dim FourLevelSub_ As String
'If Me.TextBox4_TempFourLevelSub = "" Then MsgBox "请选择末级科目！": Exit Sub
'ActiveCell = Me.TextBox3_TempThreeLevelSub.Value
oneLevelSub_ = Me.TextBox1_TempOneLevelSub.Value
TwoLevelSub_ = Me.TextBox2_TempTwoLevelSub.Value
ThreeLevelSub_ = Me.TextBox3_TempThreeLevelSub.Value
FourLevelSub_ = Me.TextBox4_TempFourLevelSub.Value
'ActiveCell = Me.TextBox4_TempFourLevelSub.Value
ActiveCell = IsNullSelectFather(oneLevelSub_, TwoLevelSub_, ThreeLevelSub_, FourLevelSub_)
Me.Hide
End Sub
Function IsNullSelectFather(oneLevelSub, TwoLevelSub, ThreeLevelSub, FourLevelSub)
If Len(oneLevelSub) > 0 And Len(TwoLevelSub) > 0 And Len(ThreeLevelSub) > 0 And Len(FourLevelSub) > 0 Then
IsNullSelectFather = FourLevelSub
ElseIf Len(oneLevelSub) > 0 And Len(TwoLevelSub) > 0 And Len(ThreeLevelSub) > 0 And Len(FourLevelSub) = 0 Then
IsNullSelectFather = ThreeLevelSub
ElseIf Len(oneLevelSub) > 0 And Len(TwoLevelSub) > 0 And Len(ThreeLevelSub) = 0 And Len(FourLevelSub) = 0 Then
IsNullSelectFather = TwoLevelSub
ElseIf Len(oneLevelSub) > 0 And Len(TwoLevelSub) = 0 And Len(ThreeLevelSub) = 0 And Len(FourLevelSub) = 0 Then
IsNullSelectFather = oneLevelSub
Else
MsgBox "您没有选择科目!"
End If
End Function
Private Sub CommandButton2_Exit_Click()
Me.Hide
End Sub

Private Sub CommandButton3_Clear_Click()
Call ClearListboxValue
End Sub

Private Sub ListBox1_OneLevelSub_Click()
Dim arOneToFourSubList() 'arOneToFourSubList
Dim k As Long
Dim n As Long
Dim m As Long
Dim getData As New GetDataSource
Me.ListBox2_TwoLevelSub.Clear
Me.ListBox3_ThreeLevelSub.Clear
Me.TextBox1_TempOneLevelSub = Me.ListBox1_OneLevelSub.Value
Me.TextBox2_TempTwoLevelSub = ""
Me.TextBox3_TempThreeLevelSub = ""
arOneToFourSubList = getData.GetDataSourceArr
Set dic = CreateObject("Scripting.Dictionary")
n = 0
For i = 1 To UBound(arOneToFourSubList)
If arOneToFourSubList(i, 1) = Me.ListBox1_OneLevelSub.Value Then
If Not dic.exists(arOneToFourSubList(i, 2)) Then
dic.Add arOneToFourSubList(i, 2), arOneToFourSubList(i, 2)
Me.ListBox2_TwoLevelSub.AddItem dic(arOneToFourSubList(i, 2))
End If
End If
Next
End Sub

 

Private Sub ListBox2_TwoLevelSub_Click()
Dim arOneToFourSubList()
Dim k As Long
Dim n As Long
Dim m As Long
Dim getData As New GetDataSource
Me.ListBox3_ThreeLevelSub.Clear
Me.TextBox2_TempTwoLevelSub = Me.ListBox2_TwoLevelSub.Value
Me.TextBox3_TempThreeLevelSub = ""
arOneToFourSubList = getData.GetDataSourceArr
Set dic = CreateObject("Scripting.Dictionary")
n = 0
For i = 1 To UBound(arOneToFourSubList)
If arOneToFourSubList(i, 1) = Me.ListBox1_OneLevelSub.Value And arOneToFourSubList(i, 2) = Me.ListBox2_TwoLevelSub.Value Then
If Not dic.exists(arOneToFourSubList(i, 3)) Then
dic.Add arOneToFourSubList(i, 3), arOneToFourSubList(i, 3)
Me.ListBox3_ThreeLevelSub.AddItem dic(arOneToFourSubList(i, 3))
End If
End If
Next
End Sub

 

Private Sub ListBox3_ThreeLevelSub_Click()
'Me.TextBox3_TempThreeLevelSub = Me.ListBox3_ThreeLevelSub.Value
Dim arOneToFourSubList()
Dim k As Long
Dim n As Long
Dim m As Long
Dim getData As New GetDataSource
Me.ListBox4_FourLevelSub.Clear
Me.TextBox3_TempThreeLevelSub = Me.ListBox3_ThreeLevelSub.Value
Me.TextBox4_TempFourLevelSub = ""
arOneToFourSubList = getData.GetDataSourceArr
Set dic = CreateObject("Scripting.Dictionary")
n = 0
For i = 1 To UBound(arOneToFourSubList)
If arOneToFourSubList(i, 1) = Me.ListBox1_OneLevelSub.Value And arOneToFourSubList(i, 2) = Me.ListBox2_TwoLevelSub.Value And arOneToFourSubList(i, 3) = Me.ListBox3_ThreeLevelSub.Value Then
If Not dic.exists(arOneToFourSubList(i, 4)) Then
dic.Add arOneToFourSubList(i, 4), arOneToFourSubList(i, 4)
Me.ListBox4_FourLevelSub.AddItem dic(arOneToFourSubList(i, 4))
End If
End If
Next
End Sub

 

'Private Sub ListBox3_ThreeLevelSub_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Call Me.CommandButton1_SelectItem_Click
'End Sub

Private Sub ListBox4_FourLevelSub_Click()
Me.TextBox4_TempFourLevelSub = Me.ListBox4_FourLevelSub.Value
End Sub

Private Sub ListBox4_FourLevelSub_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call Me.CommandButton1_SelectItem_Click
End Sub

'Private Sub UserForm_Click()
'MsgBox Me.ListBox2_TwoLevelSub.List(Me.ListBox2_TwoLevelSub.ListIndex)
'End Sub

Private Sub UserForm_Initialize()
Me.TextBox1_TempOneLevelSub = ""
Me.TextBox2_TempTwoLevelSub = ""
Me.TextBox3_TempThreeLevelSub = ""
Me.TextBox4_TempFourLevelSub = ""
End Sub
Sub ClearListboxValue()
Me.TextBox1_TempOneLevelSub = ""
Me.TextBox2_TempTwoLevelSub = ""
Me.TextBox3_TempThreeLevelSub = ""
Me.TextBox4_TempFourLevelSub = ""
Me.ListBox1_OneLevelSub.Clear
Me.ListBox2_TwoLevelSub.Clear
Me.ListBox3_ThreeLevelSub.Clear
Me.ListBox4_FourLevelSub.Clear
End Sub

 

Function GetDataSourceArr()
Dim arDataSource As Variant
With Sheet10
r = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, SearchDirection:=xlPrevious).Row
arDataSource = .Range("b2:e" & r)
End With
GetDataSourceArr = arDataSource
End Function