判別重複後，依照條件刪除 - Excel程式區

[發問] 判別重複後，依照條件刪除

1^# 跳轉到 »

發表於 2016-7-20 20:25 | 顯示全部帖子

回復 1# Michelle-W

Sub Ex()
Dim rng As Range, dic As Object
Dim r As Long
r = [A2].End(xlDown).Row
Range("$A$2:$G$" & r).RemoveDuplicates Columns:=Array(2, 4), Header:=xlYes
Set dic = CreateObject("scripting.dictionary")
For Each rng In Range("A2", [A2].End(xlDown))
If Not dic.exists(CStr(rng.Offset(, 1).Value)) Then dic(CStr(rng.Offset(, 1).Value)) = ""
If rng.Offset(, 3) <> "" Then dic(CStr(rng.Offset(, 1).Value)) = rng.Offset(, 3)
Next
For r = Range("A2").End(xlDown).Row To 2 Step -1
If Cells(r, 4) <> dic(CStr(Cells(r, 2).Value)) Then Rows(r).EntireRow.Delete
Next
End Sub

複製代碼

判斷並刪除.rar (16.53 KB)

2^#

發表於 2016-7-22 17:06 | 顯示全部帖子

回復 5# Michelle-W

Sub Ex()
Dim rng As Range, dic As Object
Dim r As Long, txt As String
r = [A2].End(xlDown).Row
Range("$A$1:$G$" & r).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7), Header:=xlYes
Set dic = CreateObject("scripting.dictionary")
For Each rng In Range("A2", [A2].End(xlDown))
If Not dic.exists(CStr(rng.Value)) Then dic(CStr(rng.Value)) = ""
If rng.Offset(, 2) <> "" Or rng.Offset(, 3) <> "" Or rng.Offset(, 4) <> "" Or rng.Offset(, 5) <> "" Or rng.Offset(, 6) <> "" Then
txt = Left(rng.Offset(, 2) & " ", 10) & Left(rng.Offset(, 3) & " ", 10) & _
Left(rng.Offset(, 4) & " ", 10) & Left(rng.Offset(, 5) & " ", 10) & Left(rng.Offset(, 6) & " ", 10)
Else
txt = ""
End If
If txt <> "" Then dic(CStr(rng.Value)) = txt
Next
For r = Range("A2").End(xlDown).Row To 2 Step -1
If Cells(r, 3) <> "" Or Cells(r, 4) <> "" Or Cells(r, 5) <> "" Or Cells(r, 6) <> "" Or Cells(r, 7) <> "" Then
txt = Left(Cells(r, 3) & " ", 10) & Left(Cells(r, 4) & " ", 10) & _
Left(Cells(r, 5) & " ", 10) & Left(Cells(r, 6) & " ", 10) & Left(Cells(r, 7) & " ", 10)
Else
txt = ""
End If
If txt <> dic(CStr(Cells(r, 1).Value)) Then Rows(r).EntireRow.Delete
Next
End Sub

複製代碼

3^#

發表於 2016-7-24 17:43 | 顯示全部帖子

回復 7# 准提部林
准大在此範例中，應用泡沫排序 (Bubble Sort) 的處理，
真是恰當好處，表現的淋漓盡致，在此受教了，謝謝您！

靜思自在 : 閒人無樂趣，忙人無是非。