Excel精英培训网

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

重复数据单元格删除的问题

[复制链接]
发表于 2018-6-26 14:50 | 显示全部楼层 |阅读模式
本帖最后由 一休和尚 于 2018-6-28 14:31 编辑

各位老师:
下表中因每天有数据不断复制粘贴进来,会导致“机床”列和“图号列”同时又重复的现象,那就要把原来的数据删除,保留最新的一行就可以了;
比如:第一行:牧野09;图号064-52723-101;如果在后面粘贴的数据中在同一行中和同一列中又有这个数据重复,就把前面的删除掉,保留最新的;
请求老师帮忙写个代码实现;
不胜感激!

日期
机床
产品名称
图号
版本
每日产量
额定工时
备注
单件运行时间
探头防错基准
快速定位使用
工时误差
工段长
车间
3/26
牧野09
排气座
064-52723-101
B
5
230
艺一艺二
115
115
付鹏飞
3
3/29
牧野07
排气座
02250300-255
6
0
177
艺一艺二
153
24
付鹏飞
3
3/30
牧野10
140电机座
4764705
3
0
400
艺一艺二
411
-11
付鹏飞
3
3/30
牧野10
120电机座
4678162
7
3
243
艺一艺二
273
-30
付鹏飞
3
3/30
牧野07
排气座
250022-812
16
0
152
艺一艺二
161
-9
付鹏飞
3
3/30
牧野07
排气座
250022-817
16
0
152
艺一艺二
147
5
付鹏飞
3
3/30
牧野07
排气座
250022-819
16
3
136
艺一艺二
106
30
付鹏飞
3
3/31
牧野09
排气座
064W51903-000
E
10
187
艺一艺二
125
62
付鹏飞
3
4/1
牧野10
029转子座
250002-029
4
4
265
艺一艺二
214
51
付鹏飞
3
4/1
牧野09
排气座
064-52118-000
E
0
187
艺一艺二
137
50
付鹏飞
3
4/3
牧野07
排气座
02250136-877
0
8
117
艺一艺二
105
12
付鹏飞
3
4/3
牧野09
排气座
064W52531-000
E
10
187
艺一艺二
132
55
付鹏飞
3
4/3
牧野08
机座
278725
A
0
200
艺一艺二
174
26
付鹏飞
3
4/4
牧野10
065转子座
02250135-065
2
0
345
艺一艺二
220
125
付鹏飞
3
4/6
牧野08
机座
278726
c
0
220
艺一艺二
206
14
付鹏飞
3
4/6
牧野10
滑阀
064W52251-230
A
0
84
艺一艺二
73
11
付鹏飞
3
4/6
牧野09
排气座
064-50126-000
M
0
187
艺一艺二
132
55
付鹏飞
3
4/6
牧野09
排气座
064W52118-000
E
0
187
艺一艺二
132
55
付鹏飞
3
4/9
牧野07
72机座
D-117323
J
2
140
艺一艺二
85
55
付鹏飞
3
4/10
牧野08
226转子座
23378185
F
1
155
艺一艺二
138
17
付鹏飞
3
5/15
牧野08
滑阀
0553323A5
4
3
93
艺一艺二艺三
77
16
付鹏飞
3
5/16
牧野08
滑阀
053323A3
4.0
10
93
艺一艺二艺三
77
16
付鹏飞
3
5/16
牧野09
排气座
064-52723-000
B
10
230
艺一艺二
301
-71
付鹏飞
3
5/17
牧野09
排气座
064W52516-000
D
4
230
艺一艺二
205
25
付鹏飞
3
5/19
牧野08
滑阀
052201G
2
12
103
艺一艺二艺三
106
-3
付鹏飞
3
5/22
牧野08
滑阀
052201B
2
6
103
艺一艺二艺三
106
-3
付鹏飞
3
5/22
牧野07
转子座
02250096-661
13
11
84
艺一艺二
90
-6
付鹏飞
3
5/24
牧野08
滑阀
053001B
2
11
112
艺一艺二艺三
125
-13
付鹏飞
3
6/2
牧野08
CF125R转子座
22482921-L
AM
7
205
艺一艺二
169
36
付鹏飞
3
6/4
牧野08
CF125R转子座
22482921
AM
7
205
艺一艺二
169
36
付鹏飞
3
6/5
牧野08
CF125R转子座
23335292-L
AM
4
205
艺一艺二
173
32
付鹏飞
3
6/5
牧野07
排气座
02250300-253
3
7
177
艺一艺二
273
-96
付鹏飞
3
6/8
牧野10
马达支撑
534E1179
-
7
138
艺一艺二
200
-62
付鹏飞
3

 楼主| 发表于 2018-6-27 16:11 | 显示全部楼层
这个是要删除两列同时重复的数据,要从前往后删除;下面的代码是从后往前删除,哪位老师帮忙改一下:
从后往前删除
Sub 删除完全相同行()
Dim arr, rng As Range, d, i&, p$, irow&
Dim s As Single
s = Timer
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
arr = ActiveSheet.UsedRange
irow = ActiveSheet.UsedRange.Row
If IsArray(arr) = False Then Exit Sub
     For i = 2 To Range("B65536").End(3).Row
     For j = 4 To Range("D65536").End(3).Row
            
     Next
     If Not d.exists(p) Then
             d(p) = i
     Else
     If rng Is Nothing Then Set rng = Cells(i + irow - 1, 2) Else Set rng = Union(rng, Cells(i + irow - 1, 4))
     End If
   
Next
If Not rng Is Nothing Then rng.EntireRow.Delete
Application.ScreenUpdating = True
MsgBox "操作完成!", vbInformation + vbOKOnly, "提示"
MsgBox "耗时" & Format(Timer - s, "0.00秒"), , "提示"
End Sub
回复

使用道具 举报

发表于 2018-6-28 10:55 | 显示全部楼层
未经验证。
  1. Sub 删除完全相同行()
  2.     Dim arr, rng As Range, d, i&, p$, irow&, x$
  3.     Dim s As Single
  4.     s = Timer
  5.     Application.ScreenUpdating = False
  6.     Set d = CreateObject("scripting.dictionary")
  7.     arr = ActiveSheet.UsedRange
  8.     irow = ActiveSheet.UsedRange.Row
  9.     Set rng = Cells(irow + 1, 4)
  10.     If IsArray(arr) = False Then Exit Sub
  11.     For i = UBound(arr) To 2 Step -1
  12.        x = arr(i, 2) & arr(i, 4)
  13.        If Not d.exists(x) Then d(x) = 1 Else Set rng = Union(rng, Cells(i, 4))
  14.     Next
  15.     rng.EntireRow.Delete
  16.     Application.ScreenUpdating = True
  17.     MsgBox "操作完成!", vbInformation + vbOKOnly, "提示"
  18.     MsgBox "耗时" & Format(Timer - s, "0.00秒"), , "提示"
  19. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2019-9-5 12:59 | 显示全部楼层
本帖最后由 一休和尚 于 2019-9-6 09:23 编辑

大哥:
你这个代码有个问题,就是每次执行的时候会把表格的第二行直接删除掉,不管数据相同与否都会执行删除,这个问题出在哪里帮忙看下!如果前面有两行以上的相同数据,执行起来是正常的;

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 14:47 , Processed in 0.554569 second(s), 8 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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