|
各位大神:
下面这段代码程序时针对Excel表格中的H列和K列的两列数据同时有重复的情况下执行删除;
目前遇到问题是,执行过程中对一直检索,时间很长;
能否请各位老师对代码进行优化;
感谢!
如下表:订单和批次同时重复的时候执行删除动作;
创建日期 | 状态 | 工作中心 | 物料描述 | 机加工流水号 | 炉号 | 库位 | 订单 | 收发类别描述 | 数量 | 批次 | 用户 | 车间描述 | 2022/5/9 | 20:01:36 | SENJ014 | 533961\07\S503/603 机身\内 | LD220512 | HD22050202 | 9999 | 1000133730 | 入库 | 1 | 22084419 | LD孔令辉 | 数控五车间 | 2022/5/9 | 20:24:17 | SENJ014 | 533961\07\S503/603 机身\内 | LD220512 | HD22050202 | 9999 | 1000133730 | 收货入库 | 1 | 22084419 | LD孔令辉 | 数控五车间 |
Sub 从前往后删除()
Dim Arr, d, i&, p$
Dim s As Single
s = Timer
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
Arr = ActiveSheet.UsedRange
If IsArray(Arr) = False Then Exit Sub
For i = UBound(Arr) To 2 Step -1
p = Arr(i, 8) & Arr(i, 11) '设置搜索列
If Not d.exists(p) Then
d(p) = ""
Else
Rows(i).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
保留最后的一行重复项; >> 改為由下往上如下,請測試看看,謝謝
Sub test1()
Dim Arr, xD, T$, i&, xU As Range
Application.ScreenUpdating = False
Set xD = CreateObject("Scripting.Dictionary")
Arr = [a1].CurrentRegion
For i = UBound(Arr) To 2 Step -1
T = Arr(i, 8) & "|" & Arr(i, 11)
If Not xD.Exists(T) Then
xD(T) = ""
Else
If xU Is Nothing Then Set xU = Rows(i) Else Set xU = Union(Rows(i), xU)
End If
Next
If Not xU Is Nothing Then xU.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
|
|