曾经的回帖整理-字典案例部分

liulang0808 · 发表于 2017-12-17 19:28

本帖最后由 liulang0808 于 2020-6-29 08:05 编辑

今天发现自己的积分超过20000了，就回忆下曾经的回帖情况。
针对字典部分重新整理了几个示例，处理法方法不一定是最优的，供参考
注意：示例中使用了数组，在实际应用中要注意数组对应的数据起止位置，避免有出入。另外在使用字典的时候，以rang对象最为key是要出问题的
比如字典变量d，d(cells(1,1))=""是会遇到问题的，要使用d(cells(1,1).value)=""

此贴留作目录
一、以A列姓名为关键字，保存最上面一条数据，删除下面的重复部分http://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=1385473&pid=9342512

二、根据A列姓名，统计各个姓名对应的数量汇总,统计次数雷同
类似于分类汇总的功能http://club.excelhome.net/forum. ... 1385473&pid=9342517

三、以A,B两列为关键字，统计数量汇总
1、使用字典直接以两列为关键字，进行累加
http://club.excelhome.net/forum. ... 1385473&pid=9342520

2、使用字典保存对应的行，然后对数组内数据累加
http://club.excelhome.net/forum. ... 1385473&pid=9342523

四、将数据转置处理
1、使用三个字典变量
http://club.excelhome.net/forum. ... 1385473&pid=9342538
另外一个求和实例
http://club.excelhome.net/forum. ... 1385473&pid=9364215
2、字典结合单元格处理，需要A,B列关键互相没有重名
http://club.excelhome.net/forum. ... 1385473&pid=9342540

五、根据A列姓名，将数据拆分到各张表内，如果表不存在，就创建新表
http://club.excelhome.net/forum. ... 1385473&pid=9342542

六、生成1到100之间不重复的十个整数
http://club.excelhome.net/forum. ... 1385473&pid=9342545

七、对某个区域的数据，进行随机排序
http://club.excelhome.net/forum. ... 1385473&pid=9342547

八、中国式排名（使用了字典，供参考）
http://club.excelhome.net/thread-1170523-1-1.html

九、二级菜单级联，使用表格事件+字典实现
http://club.excelhome.net/forum. ... 1385473&pid=9342777

十、字典+递归进行凑数
http://club.excelhome.net/thread-1385584-1-1.html回复其他人的帖子
http://club.excelhome.net/forum. ... 1388541&pid=9356555
另外一个提取N个组合的问题
http://club.excelhome.net/forum. ... 1385473&pid=9361666

也是凑数的回帖http://club.excelhome.net/forum. ... 1396706&pid=9411696

本帖跟帖代码43楼
http://club.excelhome.net/forum. ... 1385473&pid=9411699

十一、使用递归+字典求最短路径
http://club.excelhome.net/forum. ... 1385473&pid=9346547

此贴是蓝板出的题目：地址链接：
[第119期]假如你是无人驾驶车上的电脑，你想好了怎么走吗？
http://club.excelhome.net/thread-1379620-1-1.html
(出处: ExcelHome技术论坛)
截止日期是12月20日

liulang0808 · 发表于 2017-12-17 19:30

Sub 按钮1_Click()
Set d = CreateObject("scripting.dictionary")
Set Rng = Nothing
arr = [a1].CurrentRegion
Application.ScreenUpdating = False
For j = 1 To UBound(arr)
If d.exists(arr(j, 1)) Then
If Rng Is Nothing Then
Set Rng = Cells(j, 1)
Else
Set Rng = Union(Rng, Cells(j, 1))
End If
Else
d(arr(j, 1)) = ""
End If
Next j
If Not Rng Is Nothing Then Rng.EntireRow.Delete
Application.ScreenUpdating = True
End Sub

复制代码

根据A列内容，保存表格内数据最上面一行，删除下面的重复行

ww87725244 · 发表于 2017-12-17 19:30

留个沙发，呵呵
说明版主帮人无数，予人玫瑰，手有余香。感谢！感谢！
祝愿论坛越来越好！

liulang0808 · 发表于 2017-12-17 19:32

Sub 按钮1_Click()
Set d = CreateObject("scripting.dictionary")
arr = Sheets("原始数据").[a1].CurrentRegion
Application.ScreenUpdating = False
ActiveSheet.UsedRange.ClearContents
For j = 2 To UBound(arr)
d(arr(j, 1)) = d(arr(j, 1)) + arr(j, 3)
Next j
[a1:b1] = Array("客户姓名", "消费总量")
If d.Count > 0 Then
[a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
[b2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
End If
Application.ScreenUpdating = True
End Sub

复制代码

根据A列姓名，统计各个姓名对应的数量汇总
类似于分类汇总的功能

liulang0808 · 发表于 2017-12-17 19:34

Sub 按钮1_Click()
Set d = CreateObject("scripting.dictionary")
arr = Sheets("原始数据").[a1].CurrentRegion
Application.ScreenUpdating = False
ActiveSheet.UsedRange.ClearContents
For j = 2 To UBound(arr)
d(arr(j, 1) & "#" & arr(j, 2)) = d(arr(j, 1) & "#" & arr(j, 2)) + arr(j, 3)
Next j
If d.Count > 0 Then
[a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
[c2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
End If
Columns("A:A").TextToColumns Destination:=Range("A1"), OtherChar:="#"
[a1:c1].Value = Sheets("原始数据").[a1:c1].Value
Application.ScreenUpdating = True
End Sub

复制代码

以A,B列数据为关键字，统计数量汇总
使用字典直接以两列为关键字，进行累加

kings12333 · 发表于 2017-12-17 19:34

liulang0808 发表于 2017-12-17 19:30
根据A列内容，保存表格内数据最上面一行，删除下面的重复行

你这代码里刚好有个数组，问下关于数组的定义，如果我用循环的方式获取了一部分数据，我该如何用数组的方式来定义表达。。比如，循环获取网页的数据得到如下：
100
101
102
103
104
105

liulang0808 · 发表于 2017-12-17 19:35

Sub 按钮2_Click()
Set d = CreateObject("scripting.dictionary")
arr = Sheets("原始数据").[a1].CurrentRegion
Application.ScreenUpdating = False
ActiveSheet.UsedRange.ClearContents
a = 2
For j = 2 To UBound(arr)
If d.exists(arr(j, 1) & "#" & arr(j, 2)) Then
arr(d(arr(j, 1) & "#" & arr(j, 2)), 3) = arr(j, 3) + arr(d(arr(j, 1) & "#" & arr(j, 2)), 3)
Else
For i = 1 To UBound(arr, 2)
arr(a, i) = arr(j, i)
Next i
d(arr(j, 1) & "#" & arr(j, 2)) = a
a = a + 1
End If
Next j
[a1].Resize(a - 1, UBound(arr, 2)) = arr
Application.ScreenUpdating = True
End Sub

复制代码

以A,B两列为关键字，统计数量汇总，不同于楼上的方法
使用字典保存对应的行，然后对数组内数据累加

liulang0808 · 发表于 2017-12-17 19:38

kings12333 发表于 2017-12-17 19:34
你这代码里刚好有个数组，问下关于数组的定义，如果我用循环的方式获取了一部分数据，我该如何用数组的方 ...

楼主的需求看看是否可以使用动态数组，另外建议楼主自己发个求助帖看看

kings12333 · 发表于 2017-12-17 19:39

liulang0808 发表于 2017-12-17 19:38
楼主的需求看看是否可以使用动态数组，另外建议楼主自己发个求助帖看看

帖子发了，帮看看http://club.excelhome.net/thread-1385472-1-1.html

liulang0808 · 发表于 2017-12-17 19:48

Sub 按钮1_Click()
Set d = CreateObject("scripting.dictionary")
Set dnm = CreateObject("scripting.dictionary")
Set dy = CreateObject("scripting.dictionary")
arr = Sheets("原始数据").[a1].CurrentRegion
Application.ScreenUpdating = False
ActiveSheet.UsedRange.ClearContents
For j = 2 To UBound(arr)
d(arr(j, 1) & "#" & arr(j, 2)) = d(arr(j, 1) & "#" & arr(j, 2)) + arr(j, 3)
dnm(arr(j, 1)) = ""
dy(arr(j, 2)) = ""
Next j
[a2].Resize(dnm.Count) = WorksheetFunction.Transpose(dnm.keys)
[b1].Resize(1, dy.Count) = dy.keys
[a1] = "客户姓名"
arr = [a1].CurrentRegion
For j = 2 To UBound(arr)
For i = 2 To UBound(arr, 2)
arr(j, i) = d(arr(j, 1) & "#" & arr(1, i))
Next i
Next j
[a1].CurrentRegion = arr
Application.ScreenUpdating = True
End Sub
将数据转置存储，使用三个字典变量，附件见楼下

复制代码

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

[原创] 曾经的回帖整理-字典案例部分

评分

评分

评分

评分

评分

评分

评分