根据条件去重后将内容用逗号隔开

fengdiyelx · 发表于 2019-1-18 16:54

小弟刚接触VBA，在写一个按条件去重指令后将所得内容用逗号隔开的问题遇到了困难，请教下论坛各位老师；

要求如下：

1.每个人有多个属性，并且有重复
2.需要将每个人的属性去重后，合并到一起用逗号隔开后，输出到某个各自；

去重指令没问题，但是逗号隔离的指令应该怎么写呢，烦请看下附件请教一下，谢谢！！

去重求教.zip (10.72 KB, 下载次数: 13)

PQ小学生 · 发表于 2019-1-18 17:11

不懂vba可能你也用过这个或者是否尝试一下。。

chxw68 · 发表于 2019-1-18 19:27

Sub test()
Dim r%, i%
Dim arr, brr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Worksheets("sheet2")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:b" & r)
End With
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 1)) Then
Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
End If
d(arr(i, 1))(arr(i, 2)) = ""
Next
With Worksheets("sheet1")
.Range("a2:b" & .Rows.Count).Clear
m = 1
For Each aa In d.keys
m = m + 1
.Cells(m, 1) = aa
.Cells(m, 2) = Join(d(aa).keys, ",")
Next
End With
End Sub

复制代码

chxw68 · 发表于 2019-1-18 19:28

详见附件。

duquancai · 发表于 2019-1-18 19:30

本帖最后由 duquancai 于 2019-1-19 12:28 编辑

三行代码解决问题》》》》

# -*- coding: utf-8 -*-
# version: Python 3.7.0
import pandas as pd
from collections import defaultdict
#读取Excel文件中的数据，注意文件路径及表名！
data = pd.read_excel(r'D:\python\project\去重求教.xlsx', sheet_name='Sheet2')
my_dic = defaultdict(set)
for i in data.values:
my_dic[i[0]] |= {i[1]}
print(my_dic)

复制代码

duquancai · 发表于 2019-1-18 22:22

本帖最后由 duquancai 于 2019-1-19 12:22 编辑

# -*- coding: utf-8 -*-
# version: Python 3.7.0
import pandas as pd
from collections import defaultdict
#读取Excel文件中的数据，注意文件路径及表名！
data = pd.read_excel(r'D:\python\project\去重求教.xlsx', sheet_name='Sheet2')
my_dic = defaultdict(set)
for i in data.values:
my_dic[i[0]] |= {i[1]}
my_list = [[k, ','.join(list(v))] for k, v in my_dic.items()]
#数据写入Excel文件，注意文件路径！
df = pd.DataFrame(my_list, columns=['姓名','属性'])
with pd.ExcelWriter(r'D:\python\project\输出结果.xlsx') as writer:
df.to_excel(writer, 'Sheet1', index=False, header=True)

复制代码

fengdiyelx · 发表于 2019-1-18 23:55

chxw68 发表于 2019-1-18 19:27

谢谢老师指点！！有个小问题请教的话，

1. 数据量很大，而且经常更新，比方说，如果我只想看特定的某两个人（这两个人是固定的）的属性，而不是看所有人的对应属性，应该如何修改？？
2. 我尝试了一下，根据特定的人去字典寻找并赋值，不过没做出来。。能否麻烦老师在解答一下，谢谢！！

fengdiyelx · 发表于 2019-1-18 23:56

PQ小学生发表于 2019-1-18 17:11
不懂vba可能你也用过这个或者是否尝试一下。。

非常感谢，我尝试一下这个方法，数据量非常大，而且经常更新，我觉得您这个思路非常好~感谢！

MOY838840554 · 发表于 2019-1-19 08:18

Split函数：基于分隔符分割成特定数量的数组
a="A/B/C/D"
b=Split(a,"/")
那么b=array("A","B","C","D")

a="A啊B啊C啊D"
b=Split(a,"啊")
那么b=array("A","B","C","D")

jion函数：使用分隔符形成字串符，Split相反操作
b=array("A","B","C","D")

c=join(b,",")
那么c="A,B,C,D"
c=join(b,"+")
那么c="A+B+C+D"
c=join(b,"哦")
那么c="A哦B哦C哦D"

cjc209 · 发表于 2019-1-19 11:09

Sub 字典汇总()
Dim arr, brr
Set d = CreateObject("scripting.dictionary")
arr = Sheet2.Range("a1").CurrentRegion '数据装入数组

For i = 1 To UBound(arr)
      tjz = arr(i, 1) '条件
      If d.Exists(tjz) Then '字典里存在的时候
      brr = d(tjz) '字典关键字对应的条目的值装入结果数组（可以为数组）
      If InStr(brr(2), arr(i, 2)) = 0 Then
         brr(2) = brr(2) & "," & arr(i, 2) '要汇总的列
      End If
Else
      ReDim brr(1 To UBound(arr, 2)) '声明动态数组装符合条件的每列数据
      For l = 1 To UBound(arr, 2)
         brr(l) = arr(i, l) '需要的字段装入结果数组
      Next l
End If
d(tjz) = brr '更新字典条目中的值
Next
If d.Count Then
Sheet2.Range("d1").CurrentRegion.ClearContents '清除结果区的数据
brr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(d.Items)) '数组装置
Sheet2.Range("d1").Resize(d.Count, UBound(brr, 2)) = brr '赋值
End If
End Sub

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

[求助] 根据条件去重后将内容用逗号隔开