分享用类模板写的永久保存全局变量案例

q3698995

今天用类模块写了一个永久保存全局变量的案例
分享给大家。
注意key和value仅支持字符串或数字的格式。


类模块代码：

1. Option Explicit
   
2. Private d As Object
   
3. Private ws As Worksheet
   
4. Private arr()
   
5. Private r&
   
6. Private Sub Class_Initialize(): Dim i&: Set d = CreateObject("scripting.dictionary"): Set ws = 基本信息: With ws: On Error Resume Next: .ShowAllData: r = .Columns("A:B").Find("*", , , , , 2).Row: arr = .Columns("A:B").Value2: End With: For i = 1 To r: d(arr(i, 1)) = i: Next: End Sub
   
7. Public Sub Add(ByVal key As Variant, ByVal item As Variant): Dim i&, b As Boolean: i = d(key): b = i = 0: r = r - b: i = IIf(b, r, i): arr(i, 1) = key: arr(i, 2) = item: d(key) = i: ws.Range("A" & i & ":B" & i).Value2 = Array(key, item): End Sub
   
8. Public Property Get Exists(ByVal key As Variant) As Boolean: Exists = d.Exists(key): End Property
   
9. Public Property Get Items() As Variant: Dim v As Variant, i&: v = d.Items: i = UBound(v): ReDim brr(0 To i): For i = 0 To i: brr(i) = arr(v(i), 2): Next: Items = brr: End Property
   
10. Public Property Get Keys() As Variant: Keys = d.Keys: End Property
    
11. Public Sub Remove(ByVal key As Variant): Dim i&, b As Boolean: i = d(key): b = i = 0: r = r + Not b: i = i + b: On Error Resume Next: arr(i, 1) = Empty: arr(i, 2) = Empty: d.Remove key: With ws: .Range("A" & i & ":B" & i).Value2 = "": End With: End Sub
    
12. Public Sub RemoveAll(): d.RemoveAll: With ws: .Columns("A:B").Value2 = "": arr = .Columns("A:B").Value2: End With: r = 0: End Sub
    
13. Public Property Get Count&(): Count = d.Count: End Property
    
14. Public Property Get item(ByVal key As Variant) As Variant: On Error Resume Next: item = arr(d.item(key), 2): End Property
    
15. Private Sub Class_Terminate(): Set d = Nothing: Set ws = Nothing: End Sub
    

复制代码

标准模块调用测试：

1. Option Explicit
   
2. Private o As Object
   
3. 
   
4. '字典有的方法基本都有，不一一举例，注意key和value仅支持字符串或数字的格式
   
5. 
   
6. Sub ReadyObj()
   
7.     If o Is Nothing Then Set o = New GlobalVar
   
8. End Sub
   
9. 
   
10. Sub 保存全局变量()
    
11.     ReadyObj
    
12.     o.RemoveAll '清空全局变量
    
13.     o.Add "a", 1 '添加全局变量a，后期改变a的值可以用o.Add "a", 3 方法覆盖原值
    
14.     o.Add "b", 2 '添加全局变量
    
15. End Sub
    
16. 
    
17. Sub 删除全局变量()
    
18.     ReadyObj
    
19.     o.Remove "a" '删除全局变量
    
20. End Sub
    
21. 
    
22. Sub 判断全局变量是否存在()
    
23.     ReadyObj
    
24.     Debug.Print "变量a是否存在返回结果：" & o.Exists("a") '检查变量是否存在
    
25.     Debug.Print "变量b是否存在返回结果：" & o.Exists("b") '检查变量是否存在
    
26.     Debug.Print "变量c是否存在返回结果：" & o.Exists("c") '检查变量是否存在
    
27. End Sub
    
28. 
    
29. Sub 打印所有变量()
    
30.     Dim i&
    
31.     ReadyObj
    
32.     i = o.Count
    
33.     Debug.Print "变量个数为" & i & "个："
    
34.     For i = 1 To i '输出所有变量
    
35.         Debug.Print "变量" & o.Keys()(i - 1) & "的值为：" & o.Items()(i - 1)
    
36.     Next
    
37. End Sub

复制代码

jaxxcyh

留个记号，类这玩意有点深奥

18554831758

这个很好，小白一枚，需求强烈

q3698995

分享一例永久保存全局变量实用场景案例，第几次打开工作簿。

aman1516

有点犯晕，这是要动态永久保存一个全局变量的“名称”，还是变量的值呢？
若以举例的应用场景看，简单点直接将变量与值写到工作表角落头里（不受不同电脑限制），或可试下写到注册表里去（只能本电脑保存）

q3698995

aman1516 发表于 2024-8-17 09:43
有点犯晕，这是要动态永久保存一个全局变量的“名称”，还是变量的值呢？
若以举例的应用场景看，简单点直 ...

其本质其实就是写到单元格中，只是不用去记存的单元格地址，可以用名称直接返回值。
另外可以直接用类似字典的方法对其进行增删改查。

everbest2015

楼主给做个类模块应用的科普吧，感觉有点进不去