多表多列分组去重复保存唯一值

758586 · 发表于 2023-4-21 14:23

求助各位大神，谢谢各位!

很长时间都没有解决的大难题，都是由手工整理数据,效率太不说容易出错

我是菜鸟，对VBA一窍不通，尝试网上找了代码无法变通，能否请各位大神帮忙想个办法写一下代码。感谢感谢 !

希望达到的效果→ 多表多列分组去重复保存唯一值

在，1表，2表，2表中同一小分组区域内 CD两列内容去重复保存唯一值,到数据处理表C6:E列中

在，1表，2表，2表中用颜色表示的为一个分组，担会有个种各样的分组,每个分组项目名称有多有少

多表多列条件去重复.zip (75.24 KB, 下载次数: 8)

chxw68 · 发表于 2023-4-21 14:35

Sub test()
Dim r%, i%
Dim arr, brr
Dim d As Object
Dim ws As Worksheet
Set d = CreateObject("scripting.dictionary")
s = 0
For Each ws In Worksheets
If ws.Name Like "#*表" Then
With ws
r = .Cells(.Rows.Count, 3).End(xlUp).Row
arr = .Range("a7:d" & r)
For i = 1 To UBound(arr)
If Len(arr(i, 2)) = 0 Then
xm = arr(i, 3)
Else
If Not d.exists(xm) Then
Set d(xm) = CreateObject("scripting.dictionary")
End If
If Not d(xm).exists(arr(i, 3)) Then
s = s + 1
ReDim brr(1 To 3)
brr(1) = xm
brr(2) = arr(i, 3)
brr(3) = arr(i, 4)
d(xm)(arr(i, 3)) = brr
End If
End If
Next
End With
End If
Next
ReDim crr(1 To s, 1 To 3)
m = 0
For Each aa In d.keys
For Each bb In d(aa).keys
brr = d(aa)(bb)
m = m + 1
For j = 1 To UBound(brr)
crr(m, j) = brr(j)
Next
Next
Next
With Worksheets("数据处理表")
.Range("c6:e" & .Rows.Count).ClearContents
With .Range("c6").Resize(UBound(crr), UBound(crr, 2))
.Value = crr
.Borders.LineStyle = xlContinuous
With .Font
.Name = "微软雅黑"
.Size = 10
End With
End With
With .Range("c6:c" & UBound(crr) + 5 & ",e6:e" & UBound(crr) + 5)
.HorizontalAlignment = xlCenter
End With
With .Range("d6:d" & UBound(crr) + 5)
.HorizontalAlignment = xlLeft
End With
End With
End Sub

复制代码

chxw68 · 发表于 2023-4-21 14:36

详见附件。

758586 · 发表于 2023-4-21 14:54

chxw68师傅
都帮我多次了，耽误了您很多宝贵时间，感谢感谢

ykcbf1100 · 发表于 2023-4-21 15:53

参与一下。。。

758586 · 发表于 2023-4-21 16:47

本帖最后由 758586 于 2023-4-21 16:54 编辑

chxw68 发表于 2023-4-21 14:36
详见附件。

向师傅挤点牙膏

有个小问题请师指点一下 .谢谢了

排出,数据处理表,汇总表,需要怎么修改代码. 改了下工作表名会出错
如果能,分开工作表,分别汇总工程量就好了

chxw68 · 发表于 2023-4-21 16:54

758586 发表于 2023-4-21 16:47
向师傅挤点牙膏

有个小问题请师指点一下 .谢谢了

没听明白！

758586 · 发表于 2023-4-21 16:57

本帖最后由 758586 于 2023-4-21 16:59 编辑

就是改了下1表，2表，3表,工作表名会出错

chxw68 · 发表于 2023-4-21 17:01

修改好了。要汇总的表名采取排除法判断的。

758586 · 发表于 2023-4-21 17:07

本帖最后由 758586 于 2023-4-21 17:08 编辑

chxw68 发表于 2023-4-21 17:01
修改好了。要汇总的表名采取排除法判断的。

感谢chxw68师傅，帮助太多了,辛苦了谢谢

就是我要的效果

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

[求助] 多表多列分组去重复保存唯一值

评分

评分

评分

评分

[求助] 多表 多列 分组 去重复 保存唯一值

评分

评分

评分

评分

[求助] 多表多列分组去重复保存唯一值