Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 957|回复: 6

[已解决]VBA怎么指定删除部分重复数据

[复制链接]
发表于 2022-11-23 14:58 | 显示全部楼层 |阅读模式
各位大神,求帮忙看下这种VBA怎么写。每天数据量有点大,不能直接删除重复项,直接删的有部分订单编号为空白的数据会出现错误,求大神帮忙


最佳答案
2022-11-23 16:28
本帖最后由 风林火山 于 2022-11-23 16:33 编辑
  1. Sub TEST()
  2.     Dim d, k As Integer, str As String, arr, brr(), i As Integer, n As Integer
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = Sheet1.Range("a1").CurrentRegion
  5.     ReDim brr(1 To 1000, 1 To UBound(arr, 2))
  6.     For k = 2 To UBound(arr)
  7.         If arr(k, 1) = "" Then arr(k, 1) = arr(k - 1, 1)
  8.         str = arr(k, 1) & "," & arr(k, 3) & arr(k, 6)
  9.         If d.exists(str) = False Then
  10.             d(str) = ""
  11.             i = i + 1
  12.             For n = 1 To UBound(arr, 2)
  13.                 brr(i, n) = arr(k, n)
  14.             Next n
  15.         End If
  16.     Next k
  17.     Sheet2.Range("a1:b1") = Array("订单号", "备注", "商品", "商品编码", "SKU编码", "商品属性", "商品数量")
  18.     Sheet2.Columns(1).NumberFormatLocal = "@"
  19.     Sheet2.Range("a2").Resize(i, UBound(arr, 2)) = brr
  20.    
  21. End Sub

复制代码


订单整理.zip

11.4 KB, 下载次数: 5

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2022-11-23 15:23 | 显示全部楼层
给你写过了,不符合要求还是什么原因
回复

使用道具 举报

 楼主| 发表于 2022-11-23 15:43 | 显示全部楼层
风林火山 发表于 2022-11-23 15:23
给你写过了,不符合要求还是什么原因

原数据还有几列,我当时为了方便整理只复制了两列数据。只有两列数据的时候是可以的,但是其他几列数据加进去这个代码我就不会改了
回复

使用道具 举报

发表于 2022-11-23 15:55 | 显示全部楼层
你把完整数据做出来,看看怎么改
回复

使用道具 举报

 楼主| 发表于 2022-11-23 16:03 | 显示全部楼层
风林火山 发表于 2022-11-23 15:55
你把完整数据做出来,看看怎么改

不好意思啊,文档我上传错了 谢谢大神了。

数据整理.zip

14.46 KB, 下载次数: 7

回复

使用道具 举报

发表于 2022-11-23 16:28 | 显示全部楼层    本楼为最佳答案   
本帖最后由 风林火山 于 2022-11-23 16:33 编辑
  1. Sub TEST()
  2.     Dim d, k As Integer, str As String, arr, brr(), i As Integer, n As Integer
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = Sheet1.Range("a1").CurrentRegion
  5.     ReDim brr(1 To 1000, 1 To UBound(arr, 2))
  6.     For k = 2 To UBound(arr)
  7.         If arr(k, 1) = "" Then arr(k, 1) = arr(k - 1, 1)
  8.         str = arr(k, 1) & "," & arr(k, 3) & arr(k, 6)
  9.         If d.exists(str) = False Then
  10.             d(str) = ""
  11.             i = i + 1
  12.             For n = 1 To UBound(arr, 2)
  13.                 brr(i, n) = arr(k, n)
  14.             Next n
  15.         End If
  16.     Next k
  17.     Sheet2.Range("a1:b1") = Array("订单号", "备注", "商品", "商品编码", "SKU编码", "商品属性", "商品数量")
  18.     Sheet2.Columns(1).NumberFormatLocal = "@"
  19.     Sheet2.Range("a2").Resize(i, UBound(arr, 2)) = brr
  20.    
  21. End Sub

复制代码


回复

使用道具 举报

 楼主| 发表于 2022-11-23 16:52 | 显示全部楼层

非常感谢 这回总算解决了
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 13:54 , Processed in 1.232671 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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