|
创建字典对象
'后期绑定:方便代码在其他电脑上运行,推荐。
dim dic as object
Set dic = CreateObject("scripting.dictionary")
'前期绑定:可以直接声明字典对象,有对象属性和方法的提示,但在其他没有勾选引用的电脑上无法正常运行。
'引用勾选:VBE窗体-工具-引用-勾选‘Microsoft Scripting Runtime’
dim dic as New dictionary
获取字典的键、值,字典计数,删除,判断键是否存在于字典
with activesheet
'dic.count:字典计数,字典中一共有多少条记录;
'dic.keys:字典的键,写入单元格以行写入,如需以列写入单元格,调用工作表函数transpose转置;
.cells(1,1).resize(dic.count,1) = application.worksheetfunction.transpose(dic.keys)
'清除工作表单元格内容
.cells.clearcontents
'dic.items:字典的值;
.cells(1,1).resize(1,dic.count) = dic.items
'判断某内容是否存在与字典的键中
if dic.exists("内容") then debug.print "字符串‘内容’存在于字典的键中"
'清空字典,有时候其他过程也需要使用字典,当前过程已经使用完了,但我们又不想重新创建字典对象,这时候我们可以
public字典全局变量,再清空字典,供新的过程使用该字典对象。
dic.removeall
'清除单个字典键-值对,key是字典的某个需要删除的键
dic.remove key
end with
1.去重
dim dic as object
dim arr
dim st
Set dic = CreateObject("scripting.dictionary")
arr = array("可乐","雪碧","鸡翅",,"可乐","汉堡包","鸡翅")
for each st in arr
'字典的键是不能重复的,重复导入字典只会存在一个,可以利用字典这点特性去重。
'这里不需要字典的值,设置为空字符串或其他数值都可以。
dic(st) = ""
next
activesheet.range("a1").resize(dic.count,1) = application.worksheetfunction.transpose(d.keys)
2.实现sumifs条件求和
sub dic_sumif()
Application.ScreenUpdating = False
Dim dic As Object
Dim arr
Dim i As Byte
Set dic = CreateObject("scripting.dictionary")
With ActiveSheet
arr = .UsedRange
For i = 2 To UBound(arr)
'dic(arr(i,1))没有值是默认是0,通过下面方法对每一个水果的销量进行累加。
dic(arr(i, 1)) = dic(arr(i, 1)) + arr(i, 2)
Next
'使用copy方法,将表头复制到e1,f1单元格
.Range("a1:b1").Copy .Range("e1")
'字典键去重纵向写入到单元格
.Cells(2, "e").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys)
For i = 2 To dic.Count + 1
'循环输入字典键对应的值到f列
.Cells(i, "f").Value2 = dic(.Cells(i, "e").Value2)
Next
End With
set dic = Nothing
Application.ScreenUpdating = True
End Sub
3. 计数
dic(arr(i, 1)) = dic(arr(i, 1)) + 1
'在上面代码中添加下这条,修改下表头
range("f1").value2 = "计数"
4. 匹配
这个应该是使用字典应用最多的了,需要注意的是,如果使用单元格写入到字典,单元格同时也包含格式等信息,如果只需要单元格
的值,要使用单元格.value2方法,同时,字典的值也可以是数组。
Sub data_match()
Application.ScreenUpdating = False
Dim dic As Object
Dim arr
Dim i As Byte
Set dic = CreateObject("scripting.dictionary")
With ActiveSheet
arr = .Cells(1, 1).CurrentRegion
For i = 2 To UBound(arr)
'这里字典的值,用的是array数组,方便我们一下匹配多个数据,省去再创建字典对象麻烦。
dic(arr(i, 1)) = Array(arr(i, 2), arr(i, 3))
Next
For i = 2 To .Cells(1, "e").End(xlDown).row
.Cells(i, "f").Resize(1, 2) = dic(.Cells(i, "e").Value2)
Next
End With
set dic = Nothing
Application.ScreenUpdating = True
End Sub
5.key的组合和分割
dim arr
dim i,row as long
dim d as object
dim key
set d = createobject("scripting.dictionary")
with thisworkbook
arr = .sheets(1).usedrange
for i = 2 to ubound(arr)
d(join(array(arr(i,1),arr(i,2),arr(i,3)),"|")) = arr(i,4)
next
with .sheets("输出")
row = 2
for each key in d.keys
.cells(row,4).value = d(key)
.cells(row,1).resize(1,3) = split(key,"|")
row = row + 1
next
end with
end with
补充内容 (2020-3-18 10:47):
Dim cnn As new ADODB.Connection,是声明了变量又实例化了,也就是系统分配了内存。
而分两步走:
Dim cnn1 As ADODB.Connection 先是定义了变量,不会分配内存,接着
set cnn1=new ADODB.Connection 才会开始实例化,也就是分配内存。。
如果原对象存在,重新set的时候会销毁内存,进行新的类实例化
补充内容 (2020-3-18 11:58):
完整的语句应该是这样的(在a、b表都不止一列的情况下) :
str1 = "select * from ((select nm from b) as b left join (select nm from a) as a on b.nm=a.nm) where a.nm is null"
这个语句可以这样理解 两个表(绿括号)按条件合并成一个新表,再从新表中安条件提取数据。
红色括号可以省略, left join ..... on 语句 被自动判断为一个 表(语句)并优先处理,在此之前 先处理两个绿括号中的语句。 |
评分
-
2
查看全部评分
-
|