Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

工作中常用的Excel函数公式,全印在一张超大鼠标垫上
查看: 199|回复: 6

[已解决]如何去重复制内容

[复制链接]
发表于 2021-9-20 12:19 | 显示全部楼层 |阅读模式
把Sheet1的数据汇总到Sheet2中,要求:1、要是sheet2中and(A&B&C)已有相同数值则不进行汇总复制,已sheet2的数据为准。
2、要是Sheet2中and(A&B&C)不存在Sheet1的数据则把Sheet1的数据进行汇总复制到sheet2中
3、sheet1中and(A&B&C)相同时,需要把E和F列进行求和,后粘贴到Sheet2中
尝试过以下代码,但不能识别重复复制的问题,求大神指教,谢谢
Sub value2()
Dim d As Object, arr, brr, si, i&, j&, k&
Set d = CreateObject("scripting.dictionary")
arr = Sheets("sheet1").[A1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 6)
For i = 2 To UBound(arr)
    S = arr(i, 1) & "@" & arr(i, 2) & "@" & arr(i, 3)
     If Not d.exists(S) Then
        k = k + 1
        d(S) = k
        For j = 1 To 6
            brr(k, j) = arr(i, j)
        Next

    Else
        N = d(S)
        brr(N, 5) = brr(N, 5) + arr(i, 5)
        brr(N, 6) = brr(N, 6) + arr(i, 6)
    End If
Next
    On Error Resume Next
    Sheet2.Range("A65536").End(xlUp).Offset(1, 0).Resize(k, 6) = brr
Set d = Nothing
End Sub

如何在Sheet2中去重复内容.zip (17.57 KB, 下载次数: 7)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2021-9-20 18:40 | 显示全部楼层
这个意思么?
  1. Sub value2()
  2. Dim d As Object, arr, brr, si, i&, j&, k&
  3.     Set d = CreateObject("scripting.dictionary")
  4.     Set d1 = CreateObject("scripting.dictionary")
  5.     arr0 = Sheets("sheet2").[A1].CurrentRegion
  6.     For i = 2 To UBound(arr0)
  7.         S = arr0(i, 1) & "@" & arr0(i, 2) & "@" & arr0(i, 3)
  8.         d1(S) = 1
  9.     Next
  10.     arr = Sheets("sheet1").[A1].CurrentRegion
  11.     ReDim brr(1 To UBound(arr), 1 To 6)
  12.     For i = 2 To UBound(arr)
  13.         S = arr(i, 1) & "@" & arr(i, 2) & "@" & arr(i, 3)
  14.         If Not d1.exists(S) Then
  15.             If Not d.exists(S) Then
  16.                 k = k + 1
  17.                 d(S) = k
  18.                 For j = 1 To 6
  19.                     brr(k, j) = arr(i, j)
  20.                 Next
  21.             Else
  22.                 N = d(S)
  23.                 brr(N, 5) = brr(N, 5) + arr(i, 5)
  24.                 brr(N, 6) = brr(N, 6) + arr(i, 6)
  25.             End If
  26.         End If
  27.     Next
  28.     On Error Resume Next
  29.     Sheet2.Range("A65536").End(xlUp).Offset(1, 0).Resize(k, 6) = brr
  30.     Set d = Nothing
  31. End Sub
复制代码

如何不粘贴Sheet2中不重复内容02.rar (15.69 KB, 下载次数: 1)
回复

使用道具 举报

 楼主| 发表于 2021-9-21 07:47 | 显示全部楼层

这样要是sheet1中产生同日期同类型的的数据时,sheet2不会累加呢。
回复

使用道具 举报

发表于 2021-9-21 08:49 | 显示全部楼层
建议准确提出问题所在的地方,而非让人去猜问题出在哪里。光是简单描述下,半天不知道问题出在哪里。
你多模拟几个同日期类型的数据,截图,箭头说明想要的结果和现有错误的结果,这样一目了然。
回复

使用道具 举报

 楼主| 发表于 2021-9-22 10:51 | 显示全部楼层
zhanglei1371 发表于 2021-9-21 08:49
建议准确提出问题所在的地方,而非让人去猜问题出在哪里。光是简单描述下,半天不知道问题出在哪里。
你多 ...

对不起,是我描述不够具体。代码修改后,执行代码后,要是在Sheet1新增一个同一天的型号,sheet2不会对该型号进行累加
2021-09-22_104750.png





回复

使用道具 举报

发表于 2021-9-22 14:55 | 显示全部楼层    本楼为最佳答案   
531tommy 发表于 2021-9-22 10:51
对不起,是我描述不够具体。代码修改后,执行代码后,要是在Sheet1新增一个同一天的型号,sheet2不会对该 ...

祝順心,南無阿彌陀佛!

demo.rar

19.31 KB, 下载次数: 4

回复

使用道具 举报

 楼主| 发表于 2021-9-23 09:45 | 显示全部楼层
cutecpu 发表于 2021-9-22 14:55
祝順心,南無阿彌陀佛!

十分感谢啊。

评分

参与人数 1学分 +2 收起 理由
cutecpu + 2 不客气。祝顺心,南无阿弥陀佛!

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2021-10-20 07:48 , Processed in 0.189077 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表