Excel Tool

Order Online
Our company contact information There you can find frequently asked questions and answers

Home | Products |Purchase | FAQ | Contact Us | Useful Resources

Use a dictionary instead of dictionary nested multilevel linkage function

Nested with dictionary (Dictionary nested dictionaries) can be multistage linkage function, is easy to use, the amount of data not too large, nested series, rate is still possible, but if the amount of data is too large, or nested series too much, the speed will be become very slow below with a few examples that use a dictionary, or a few dictionary instead of nested dictionaries as multistage linkage function:

1.
Three level linkage list box

Use a dictionary instead of dictionary nested multilevel linkage function

VBA code is as follows:


 

The Dictionary Nested

Dim d1 As New Dictionary
Dim d2 As New Dictionary
Dim D4 As New Dictionary

Private Sub ListBox1_Click()
Dim m As Long, i As Long, arr
ListBox2.Clear
ListBox3.Clear
ListBox2.List = d1(ListBox1.Text).Keys
End Sub

Private Sub ListBox2_Click()
ListBox3.Clear
ListBox3.List = d2(ListBox1.Text & ListBox2.Text).Items
End Sub

Private Sub UserForm_Initialize()
tt = Timer
Dim n As Long, i As Long, arr
n = Sheets("SHEET1").[a65536].End(xlUp).Row
arr = Sheets("SHEET1").[a1].Resize(n, 3)
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To n
D4.Add arr(i, 1) & "", ""
xx = arr(i, 1) & ""
yy = arr(i, 2) & ""
zz = arr(i, 3) & ""
xh = arr(i, 1) & arr(i, 2)
If d1.Exists(xx) = False Then Set d1(xx) = New Dictionary 'The dictionary nested
d1(xx)(yy) = zz
If d2.Exists(xh) = False Then Set d2(xh) = New Dictionary 'The dictionary nested
d2(xh)(zz) = zz
Next
UserForm1.ListBox1.List = d1.Keys
Application.ScreenUpdating = True
MsgBox Timer - tt
End Sub


A dictionary is used to implement the VBA code is as follows:

A Dictionary

Dim d As Object

Private Sub ListBox1_Click()
Dim m As Long, i As Long, arr
ListBox2.Clear
ListBox3.Clear
ListBox2.List = Split(Mid(d(ListBox1.Text), 2), ",")
End Sub

Private Sub ListBox2_Click()
ListBox3.Clear
ListBox3.List = Split(Mid(d(ListBox1.Text & vbTab & ListBox2.Text), 2), ",")
End Sub

Private Sub UserForm_Initialize()
tt = Timer
Dim i As Long, arr
arr = Sheets("Sheet1").Range("A1").CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
If InStr(d(arr(i, 1)) & ",", "," & arr(i, 2) & ",") = 0 Then d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 2) 'If does not contain the level 2 project in dictionary entry, then add level 1 project key values in the dictionary, the secondary project added to the dictionary entry, and the original entries by commas
If InStr(d(arr(i, 1) & vbTab & arr(i, 2)) & ",", "," & arr(i, 3) & ",") = 0 Then d(arr(i, 1) & vbTab & arr(i, 2)) = d(arr(i, 1) & vbTab & arr(i, 2)) & "," & arr(i, 3) 'If not in the dictionary entry contains the three-stage project, is the primary and secondary projects with vbTab connect key value added to the dictionary, add 3 project entry in the dictionary, and the original entries by commas
Next
ListBox1.List = Filter(d.Keys, vbTab, False) 'Remove elements containing vbTab
MsgBox Timer - tt
End Sub

 

Example File: three-level-linkage-listbox.xlsm

Copyright © 2001-2016 Excel-Tool All Rights Reserved.

Copyright Excel-Tool All rights reserved