一个有意思的字典，树形字典 TreeDic！

xiaofan1999

山中老人 发表于 2021-4-25 16:05
教程3 Object 与 Value

接前面，我们的树结构搭建好了，现在可以在上面挂东西了（存取数据）！

谢谢大侠再次指点！

xxdoc

需要加一个保存和读取的功能才行。感觉和json差不多。。不然不好用

山中老人

xxdoc 发表于 2021-4-25 18:40
需要加一个保存和读取的功能才行。感觉和json差不多。。不然不好用

文本导入/导出很简单，如果确有需要，加上去就好了！

导出结构用：AllBranchPath
导入结构先分解成行（树枝），再 一个个用PathBranch 建立

aman1516

不明觉厉，收藏再说，感谢分享！

xiaofan1999

山中老人 发表于 2021-4-25 19:01
文本导入/导出很简单，如果确有需要，加上去就好了！

导出结构用：AllBranchPath

绝对好贴，虽然目前看不懂，先收藏再说，感谢分享！

cui26896

感谢楼主分享，收藏学习，留下脚步。

山中老人

教程5 文本导入导出
接前面，有网友提出将树形数据结构以文本的形式导入导出问题。
我对应做出了一些修改，由于使用【分隔字符】的地方很多，我将它们独立出来作为属性。

Dlmt_Branch As String 'Branch分隔字符（Branch间分隔） 默认： "/"
Dlmt_ValueLeft As String 'Value左分隔（分隔Branch名与Value名） 默认："."
Dlmt_ValueEqual As String 'Value 等号（分隔Value名与值） 默认："="
Dlmt_Item As String '项目分隔字符(行分隔) 默认：vbCrLf  （回车换行）


注意： 一个树形结构所有树桩、分支使用的上述属性都是通用的，在分支这些属性只读


文本导出相关方法、属性：


TreeDic.Path 声明：
Public Function Path() As String '访问路径
    'Branch间分隔符：Me.Dlmt_Branch

演示一下：
     Dim TD As New TreeDic
     Dim Brc As TreeDic ： Set Brc = TD("中国")("四川")("成都")("武侯区")
     Debug.Print Brc.Path
输出:
/中国/四川/成都/武侯区

Public Function ValueStr(ByVal Key As Variant, Optional AddPath As Boolean = True) As String '值的(带路径)表达式
    '路径分隔符：Me.Dlmt_Branch
    '路径Value名分隔符：Me.Dlmt_ValueLeft
    'Value 等号（分隔Value名与值）：Me.Dlmt_ValueEqual
    'AddPath=是否带路径

演示一下：
     Dim TD As New TreeDic
     Dim Brc As TreeDic ： Set Brc = TD("中国")("四川")("成都")("武侯区")
     Brc.Value("面积") = 76.56
     Debug.Print Brc.ValueStr("面积")
输出:
/中国/四川/成都/武侯区.面积=76.56

TreeDic.AllBranchPath 声明：
Public Function AllBranchPath() As String '输出所有分支路径表达式
    '路径分隔符：Me.Dlmt_Branch
    '项目分隔字符(行分隔)：Me.Dlmt_Item

演示一下：
     Dim TD As New TreeDic
     Dim Brc As TreeDic ： Set Brc = TD("中国")("四川")("成都")("武侯区")
     Set Brc = TD("中国")("四川")("巴中")("江北区")
     Debug.Print TD.AllBranchPath
输出:
/中国
/中国/四川
/中国/四川/成都
/中国/四川/成都/武侯区
/中国/四川/巴中
/中国/四川/巴中/江北区

山中老人

太长发不了，接上面。

导出
TreeDic.AllBranchValueTxt 声明：
Public Function AllBranchValueTxt(Optional CompressedRow As Boolean = True) As String '以文本输出全部分支及值
    '路径分隔符：Me.Dlmt_Branch
    '路径Value名分隔符：Me.Dlmt_ValueLeft
    'Value 等号（分隔Value名与值）：Me.Dlmt_ValueEqual
    '项目分隔字符(行分隔)：Me.Dlmt_Item
    'CompressedRow=压缩行（将不影响重建的行去掉）

导入
TreeDic.LoadTxt 声明：
Public Function LoadTxt(ByVal Txt As String) As Boolean '以文本加载分支及值
    'Txt=BranchValue文本
    '路径分隔符：Me.Dlmt_Branch
    '路径Value名分隔符：Me.Dlmt_ValueLeft
    'Value 等号（分隔Value名与值）：Me.Dlmt_ValueEqual
    '项目分隔字符(行分隔)：Me.Dlmt_Item

演示一下：
    Dim TD As New TreeDic    TD.Value("总人口") = 335
    Dim whq As TreeDic:
    Set whq = TD("中国")("四川")("成都")("武侯区")
    whq.Value("面积") = 76.56
    whq.Value("面积单位") = "平方公里"
    Dim BZS As TreeDic: Set BZS = TD("中国")("四川")("巴中")
    BZS.Value("电话区号") = "0827"
    Dim JB As TreeDic: Set JB = BZS("江北区")
    JB.Value("邮政编码") = 636099
    TD("中国")("四川").Value("人口") = 123456789
    Dim Txt As String
    Txt = TD.AllBranchValueTxt(True) '压缩导出
    TD.Class_Terminate '清空数据
    Debug.Print Txt
    Debug.Print "================"
    TD.LoadTxt Txt  '重新导入
    Txt = TD.AllBranchValueTxt(False)  '完整导出
    Debug.Print Txt
    TD.Class_Terminate '清空数据

输出:
.总人口=335
/中国/四川.人口=123456789
/中国/四川/成都/武侯区.面积=76.56
/中国/四川/成都/武侯区.面积单位=平方公里
/中国/四川/巴中.电话区号=0827
/中国/四川/巴中/江北区.邮政编码=636099
================
.总人口=335
/中国
/中国/四川
/中国/四川.人口=123456789
/中国/四川/成都
/中国/四川/成都/武侯区
/中国/四川/成都/武侯区.面积=76.56
/中国/四川/成都/武侯区.面积单位=平方公里
/中国/四川/巴中
/中国/四川/巴中.电话区号=0827
/中国/四川/巴中/江北区
/中国/四川/巴中/江北区.邮政编码=636099


TreeDic.PathBranch 声明：
Public Function PathBranch(ByVal Path As String, Optional ByVal IsNew As Boolean = False) As TreeDic '依据[路径]选择[分支]
    '路径分隔符：Me.Dlmt_Branch
    'IsNew=当指定的Branch不存在时,自动创建它

演示一下：
     Dim TD As New TreeDic
     Dim Brc As TreeDic: Set Brc = TD.PathBranch("/中国/四川/成都/武侯区", True)
     Debug.Print Brc.Path
输出:
     /中国/四川/成都/武侯区

树形分类统计2.rar (95.41 KB, 下载次数: 89)

2021-4-27 07:21 上传

点击文件名下载附件

最后: 大家要注意，当使用 文本导入导出功能时，将意味所有的数据将被强制转换成字符类型数据，将与原始数据有一定的差异！

山中老人

更新 1 完成

1、更新了 TreeDic.LoadTxt 的文本解析代码 及错误提示，这样方便大家用任何稀奇古怪的文本来折磨它！

2、给 [清空数据/结构]TreeDic.Class_Terminate 方法，加了个壳 TreeDic.Clear 这样是不是看起来不那么简单粗暴了！
注意：由于TreeDic可能出现内存上下级相互锁定（这是TreeDic.Parent 的副作用），导致你在程序中丢弃的TreeDic实例，可能不会被VBA的内存回收机制销毁，一直占用内存。
当使用TreeDic同时满足下面条件时：
a、代码复杂，长时间执行（比如 有用户交互界面） b、树桩在丢弃时仍然有树枝。（包括 Set TD=Nothing）
请执行 TreeDic.Class_Terminate 或 TreeDic.Clear '清空数据/结构
当然，如果你把它当做标准的Dictionary来使用，不使用分支功能，不用考虑这个问题。

3、还有两个小功能，有的时候很有用。

Public Property Get KeyIndex(Key As Variant) As Long 'Key定位（查找Key在 Keys数组中的位置，未找到返回 -1）
Public Property Get Key(Key_ As Variant) As Variant ' 标准化Key (读取字典中保存的Key)
当TreeDic.CompareMode=TextCompare 时，用来确定字典中的Key是什么

4、TreeDic 其实首先是一个字典，保留了字典的全部使用方法，所以忘掉它的Tree功能吧！
用它替换掉大部分Dictionary吧！当代你想要使用树形结构的时候，让它给你惊喜！

例如：
    Dim Dic As Dictionary
    Set Dic = New TreeDic

树形分类统计2.rar (90.77 KB, 下载次数: 127)

2021-4-27 08:06 上传

点击文件名下载附件

pc_12

感谢楼主分享，收藏学习，留下脚步。