常见字典用法集锦及代码详解

ljx63426

讲得通俗易懂，占个位好好学习

lhsh36183

大师辛苦了！等待大师的续贴。谢大师。

tangsong1026

学习啦

李巴

Sub cfz()
Dim i&, Myr&, Arr
Dim d, k, t
Set d = CreateObject("Scripting.Dictionary")
Myr = Sheet1.[a65536].End(xlUp).Row
Arr = Sheet1.Range("a1:g" & Myr)
For i = 2 To UBound(Arr)
    d(Arr(i, 3)) = d(Arr(i, 3)) + 1
Next
k = d.keys
t = d.items
Sheet2.Activate
[a2].Resize(d.Count, 1) = Application.Transpose(k)
[b2].Resize(d.Count, 1) = Application.Transpose(t)
[a1].Resize(1, 2) = Array("姓名", "重复个数")
Set d = Nothing
End Sub
-------------------
d(Arr(i, 3)) = d(Arr(i, 3)) + 1
这句我不懂，比如说2行的3列第一个姓名即便只有一个，他也有数值1，为什么最后他不会显出来，而只会显示重复的呢

w_hb

好东东，一定要学

abc123qqq

好贴，支持

yvhgydn

实例三可以写为
Sub 余1余5()  'by:狼版主
Dim dic As Object, i As Long, arr
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To 1000
dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "", "@"), ""
Next
arr = WorksheetFunction.Transpose(Filter(dic.keys, "@", 0))
[a1].Resize(UBound(arr), 1) = arr
'[a:a].Replace "@", ""
Set dic = Nothing
End Sub
吧

[ 本帖最后由 yvhgydn 于 2010-10-22 18:43 编辑 ]

蓝桥玄霜

原帖由 李巴 于 2010-10-21 21:17 发表
Sub cfz()
Dim i&, Myr&, Arr
Dim d, k, t
Set d = CreateObject("Scripting.Dictionary")
Myr = Sheet1.[a65536].End(xlUp).Row
Arr = Sheet1.Range("a1:g" & Myr)
For i = 2 To UBound(Arr)
    d(Arr(i, 3 ...

这里是只要有关键字出现一次，它对应的项就加1。就象普通变量m=m+1一样的意思。

蓝桥玄霜

原帖由 yvhgydn 于 2010-10-22 18:41 发表
实例三可以写为
Sub 余1余5()  'by:狼版主
Dim dic As Object, i As Long, arr
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To 1000
dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "", "@"), ""
Next ...

不可以。
你可以测试一下，答案是错误的。请看：
Filter函数
      

描述

返回一个下标从零开始的数组，该数组包含基于指定筛选条件的一个字符串数组的子集。

语法

Filter(sourcesrray, match[, include[, compare]])

Filter函数语法有如下的命名参数：

部分 描述
sourcearray 必需的。要执行搜索的一维字符串数组。
match 必需的。要搜索的字符串。
include 可选的。Boolean值，表示返回子串包含还是不包含match字符串。如果include是True，Filter返回的是包含match子字符串的数组子集。如果include是False，Filter返回的是不包含match子字符串的数组子集。
compare 可选的。数字值，表示所使用的字符串比较类型。有关其设置，请参阅下面的“设置值”部分。
Filter函数的第3个参数有两个选择：true(1)、False(0)。如果用了0，则返回的是不包含"@"子字符串的数组子集，所以答案不对了。

yvhgydn

Sub 余1余5()  'by:狼版主
Dim dic As Object, i As Long, arr
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To 1000
dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "", "@"), ""
Next
arr = WorksheetFunction.Transpose(Filter(dic.keys, "@", 0))
[a1].Resize(UBound(arr), 1) = arr
'[a:a].Replace "@", ""
Set dic = Nothing
End Sub
对FILTER 第三参数使用了0
但去除了第9行代码：[a:a].Replace "@", ""
是没有问题的，已试验过的，请楼主详查

[ 本帖最后由 yvhgydn 于 2010-10-22 23:15 编辑 ]