字典计数之后，如何遍历，然后只反馈满足条件的值？

carlostevez1984 · 发表于 2019-3-13 09:38

本帖最后由 carlostevez1984 于 2019-3-14 10:50 编辑

Sub Test1()
Application.ScreenUpdating = False

Dim tt1(), tt2()
Set d1 = CreateObject("scripting.dictionary")
For tt = 5 To Range("a10000").End(xlUp).Row
d1.Item(CStr(Cells(tt, "a"))) = d1.Item(CStr(Cells(tt, "a"))) + 1
Next
tt1 = d1.keys
tt2 = d1.items
With Sheets("复核结果")
.Range("a1:b1") = Array("编号", "出现次数")
.Range("a2").Resize(d1.Count, 1) = Application.Transpose(tt1)
.Range("b2").Resize(d1.Count, 1) = Application.Transpose(tt2)
End With
Application.ScreenUpdating = True
End Sub
如何在复核结果这个表只反馈编号出现次数大于30的值？

wj2368 · 发表于 2019-3-13 09:54

本帖最后由 wj2368 于 2019-3-13 09:55 编辑

Sub Test1()
Application.ScreenUpdating = False
Dim tt1(), tt2()
Set d1 = CreateObject("scripting.dictionary")
For tt = 5 To Range("a10000").End(xlUp).Row
d1.Item(CStr(Cells(tt, "a"))) = d1.Item(CStr(Cells(tt, "a"))) + 1
Next
tt1 = d1.keys
tt2 = d1.items
With Sheets("复核结果")
.[a1:b100].ClearContents
.Range("a1:b1") = Array("编号", "出现次数")
a = 1
For i = 0 To UBound(tt1)
If tt2(i) > 30 Then
a = a + 1
.Cells(a, 1) = tt1(i)
.Cells(a, 2) = tt2(i)
End If
Next
End With
Application.ScreenUpdating = True
End Sub

朱荣兴 · 发表于 2019-3-13 10:03

提示: 作者被禁止或删除内容自动屏蔽

		自动登录	找回密码
密码			免费注册

[已解决] 字典计数之后，如何遍历，然后只反馈满足条件的值？

评分

朱荣兴朱荣兴当前离线性别保密 UID 1318548 阅读权限 0 注册时间 2011-2-2 在线时间小时最后登录 1970-1-1 积分 19282 财富分享技术精华头像被屏蔽 TA的精华主题 TA的得分主题	发表于 2019-3-13 10:03 \| 显示全部楼层 [广告] ★ExcelHome默写助手 - 不用妈妈陪的默写神器 · Word/WPS插件 · 自定义默写单 · 自定义描红字帖★ 提示: 作者被禁止或删除内容自动屏蔽

	回复举报