字典能记载Range的数据特性。

ning84

从这张图看，Range的数据特点。

1. Sub del()
   
2.    Dim Dict As Dictionary
   
3.        Set Dict = New Dictionary
   
4.    Dim Rng As Range, Arr
   
5.        Set Rng = Sheet1.Cells(6, 1).CurrentRegion
   
6.        Debug.Print Rng.Address
   
7.    For ii = 1 To Rng.Rows.Count
   
8.         Set Dict(Rng(ii, 2)) = Rng(ii, 1)
   
9.    Next ii
   
10.    For ii = 0 To Dict.Count - 1
    
11.       Set Rng = Dict.Items(ii)
    
12.       Debug.Print Rng.Address
    
13.    Next ii
    
14. End Sub
    

复制代码

运行结果



$A$3:$Q$35
$A$3
$A$4
$A$5
$A$6
$A$7
$A$8
$A$9
$A$10
$A$11
$A$12
$A$13
$A$14
$A$15
$A$16
$A$17
$A$18
$A$19
$A$20
$A$21
$A$22
$A$23
$A$24
$A$25
$A$26
$A$27
$A$28
$A$29
$A$30
$A$31
$A$32
$A$33
$A$34
$A$35

zxsea_7426

这楼主想表达的是什么？？？

aails6543

谢谢分享，学习一下

aman1516

Set Dict(Rng(ii, 2)) = Rng(ii, 1)
与
Dict(Rng(ii, 2)) = Rng(ii, 1)
的差别

ning84

aman1516 发表于 2022-12-12 20:01
Set Dict(Rng(ii, 2)) = Rng(ii, 1)
与
Dict(Rng(ii, 2)) = Rng(ii, 1)

测试一下，你列举的两种方法，结果是一样的。

1. Sub del()
   
2.    Dim Dict As Dictionary, Dict1 As Dictionary
   
3.        Set Dict = New Dictionary
   
4.        Set Dict1 = New Dictionary
   
5.    Dim Rng As Range, Arr
   
6.        Set Rng = Sheet1.Cells(6, 1).CurrentRegion
   
7.        Set Rng = Rng(4, 1).Resize(9, 10)
   
8.        Debug.Print Rng.Address
   
9.        Rng.Select
   
10.        Rng.Sort key1:=Sheet1.Range("A4")
    
11.       
    
12.    For ii = 1 To 2 ' Rng.Rows.Count
    
13.         Dict(Rng(ii, 2)) = Rng(ii, 1)
    
14.    Next ii
    
15.    ''
    
16.    For ii = 1 To 2 'Rng.Rows.Count
    
17.         Dict1(Rng(ii, 2)) = Rng(ii, 1)
    
18.    Next ii
    
19. 
    
20.    Stop
    
21.    For ii = 0 To Dict.Count - 1
    
22.       Set Rng = Dict.Items(ii)
    
23.       Debug.Print Rng.Address
    
24.    Next ii
    
25. End Sub

复制代码

aman1516

ning84 发表于 2022-12-12 21:24
测试一下，你列举的两种方法，结果是一样的。

嗯，有点想当然了
字典的ITEM作为一个条目对象，集合
你赋予其什么，它就是什么
既然前面 Dim Rng As Range 了，Dict1(Rng(ii, 2)) = Rng(ii, 1) 赋予ITEM，自然就具备Range的属性
若改为 Dict1(Rng(ii, 2)) =  Rng(ii, 1).Value
此时可查看下 Dict.Items(ii) 的内容
若再 Set Rng = Dict.Items(ii) ，就会出错了吧
没测试，继续想当然的分析

aman1516

探讨探讨：

1. 
   
2. Sub del2()
   
3.    Dim Dict As Dictionary, Dict1 As Dictionary
   
4.        'Set Dict = New Dictionary
   
5.        'Set Dict1 = New Dictionary
   
6.        Set Dict = CreateObject("Scripting.Dictionary")
   
7.        Set Dict1 = CreateObject("Scripting.Dictionary")
   
8.    Dim Rng As Range, Arr
   
9.        Set Rng = Sheet1.Cells(1, 1).CurrentRegion
   
10.        'Debug.Print Rng.Address
    
11.        Rng.Select
    
12.       
    
13.    ' Rrange具有Copyμ等属性¸′并可复制所有单元格格式 ，可操作更直观的验证下，当然 .Address 属性已可以验证确认
    
14.    'For ii = 1 To Rng.Rows.Count
    
15.    '    Set Dict(Rng(ii, 2)) = Rng(ii, 1)    'OK
    
16.    '    Debug.Print Dict.Items(ii - 1).Address    'OK
    
17.    '    Dict.Items(ii - 1).Copy Sheet1.Cells(ii + 1, 18)    'OK
    
18.    'Next ii
    
19.    
    
20.    For ii = 1 To Rng.Rows.Count
    
21.        Dict(Rng(ii, 2)) = Rng(ii, 1)     'OK
    
22.        Debug.Print Dict.Items(ii - 1)    'OK
    
23.    '    Debug.Print Dict.Items(ii - 1).Address   'NG
    
24.    '    Dict.Items(ii - 1).Copy Sheet1.Cells(ii + 1, 18)   'NG
    
25.    Next ii
    
26.    
    
27.    'For ii = 1 To Rng.Rows.Count
    
28.    '    Dict(Rng(ii, 2)) = Rng(ii, 1).Value     'OK
    
29.    '    Set Dict(Rng(ii, 2)) = Rng(ii, 1).Value    'OK
    
30.    '    Debug.Print Dict.Items(ii - 1)    'OK
    
31.    '    Debug.Print Dict.Items(ii - 1).Address   'NG
    
32.    '    Dict.Items(ii - 1).Copy Sheet1.Cells(ii + 1, 18)   'NG
    
33.    'Next ii
    
34.      
    
35.    'Stop
    
36.    For ii = 0 To Dict.Count - 1
    
37.        Set Rng = Dict.Items(ii)     'Rng 定义为 Rrange 可否赋值 ，得看 Dict.Items(ii) 是否也是 Rrange
    
38.        Debug.Print Rng.Address
    
39.        Rng.Copy Sheet1.Cells(ii + 1, 18)
    
40.    Next ii
    
41.    
    
42. End Sub
    

复制代码

aman1516

详见附件，请测试
Book1.rar (18.38 KB, 下载次数: 1)

2022-12-13 14:12 上传

点击文件名下载附件

ning84

aman1516 发表于 2022-12-13 14:11
探讨探讨：

谢谢回复，又做了优化说明主题Dictionary与Range的关联。不破坏Range的结构性质。



.

1. Sub del()
   
2.     Dim Rng As Range, ii, jj
   
3.     Dim tmp, Str, Arr, Arr1
   
4.     Dim Dict As Dictionary
   
5.         Set Dict = New Dictionary
   
6.     For Each Rng In Sheet1.Range("A1:A10")
   
7.         Set Dict(Rng.Value) = Rng
   
8.     Next Rng
   
9.     With Dict
   
10.          Arr1 = .Items
    
11.          Arr = .Keys
    
12.          For ii = 0 To .Count - 1
    
13.              Set Rng = .Items(ii)
    
14.              'Debug.Print Rng.Address, Rng
    
15.          Next ii
    
16.          ''
    
17.          For ii = 1 To .Count '- 1
    
18.              For jj = 1 To .Count - 1
    
19.                  'Debug.Print Dict(Arr(ii)), Dict(Arr(jj))
    
20.                  If Dict(Arr(ii - 1)) > Dict(Arr(jj - 1)) Then
    
21.                       Set tmp = Dict(Arr(ii - 1))
    
22.                       Set Dict(Arr(ii - 1)) = Dict(Arr(jj - 1))
    
23.                       Set Dict(Arr(jj - 1)) = tmp
    
24.                  End If
    
25.              Next jj
    
26.          Next ii
    
27.          ''
    
28.          For ii = 0 To .Count - 1
    
29.               Debug.Print Dict.Items(ii), Dict.Keys(ii),
    
30.               Set Rng = Dict.Items(ii)  ' Dict.Items(ii)
    
31.               Debug.Print Rng.Address, Rng.Value2
    
32.               Sheet1.Cells(1 + ii, 5) = "=" & Rng.Address
    
33.          Next ii
    
34.     End With
    
35. End Sub
    

复制代码

aman1516

只是好奇楼主知道 "字典能记载Range的数据特性" 后有什么好的、特殊的应用？