![](/img/trans.png)
[英]Delete the row if the cell value on sheet is the same then the cell value on another sheet
[英]Delete entire row if the same value is found in another cell on the same row
首先,我必须提到我正在使用Excel for Mac ,因此任何代码建议都需要适用于使用 Office 365 的 Mac 。
我有一个包含九列名称的大型数据集。 如果同一行的多个列中有相同的名称,我想删除整行
示例数据集:
所以所有这些行都将被删除,因为:
Jason
在第1
行出现twice
Jason
在第2
行出现3
次Jason
在第3
行出现4
次Sam
在第4
行出现twice
Fred
在第5
行出现3
次因此,无论名称在同一行数据中重复多少次,我都想删除该整行。
我的代码如下。 此代码有效,但它与大型数据集崩溃。 我知道必须有一种更快、更有效的方法来编写此代码,以便它可以处理大型数据集。 另外,我的代码太重复了。 必须有一种方法可以使代码更简单。 无论如何,这是代码。
'<---- ***** DELETE ANY ROWS WHERE SAME NAME APPEARS TWICE (OR MORE) IN THAT ROW
Sub RemoveDuplicateRows()
Dim Lastrow As Long
Dim Lrow As Long
Lastrow = Range("A" & Rows.Count).End(xlUp).row
For Lrow = Lastrow To 2 Step -1
If Cells(Lrow, "A").Value = Cells(Lrow, "B").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "A").Value = Cells(Lrow, "C").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "A").Value = Cells(Lrow, "D").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "A").Value = Cells(Lrow, "E").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "A").Value = Cells(Lrow, "F").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "A").Value = Cells(Lrow, "G").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "A").Value = Cells(Lrow, "H").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "A").Value = Cells(Lrow, "I").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "B").Value = Cells(Lrow, "C").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "B").Value = Cells(Lrow, "D").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "B").Value = Cells(Lrow, "E").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "B").Value = Cells(Lrow, "F").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "B").Value = Cells(Lrow, "G").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "B").Value = Cells(Lrow, "H").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "B").Value = Cells(Lrow, "I").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "C").Value = Cells(Lrow, "D").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "C").Value = Cells(Lrow, "E").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "C").Value = Cells(Lrow, "F").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "C").Value = Cells(Lrow, "G").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "C").Value = Cells(Lrow, "H").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "C").Value = Cells(Lrow, "I").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "D").Value = Cells(Lrow, "E").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "D").Value = Cells(Lrow, "F").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "D").Value = Cells(Lrow, "G").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "D").Value = Cells(Lrow, "H").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "D").Value = Cells(Lrow, "I").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "E").Value = Cells(Lrow, "F").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "E").Value = Cells(Lrow, "G").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "E").Value = Cells(Lrow, "H").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "E").Value = Cells(Lrow, "I").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "F").Value = Cells(Lrow, "G").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "F").Value = Cells(Lrow, "H").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "F").Value = Cells(Lrow, "I").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "G").Value = Cells(Lrow, "H").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "G").Value = Cells(Lrow, "I").Value Then
Cells(Lrow, "A").EntireRow.Delete
ElseIf Cells(Lrow, "H").Value = Cells(Lrow, "I").Value Then
Cells(Lrow, "A").EntireRow.Delete
End If
Next Lrow
End Sub
假设您的数据如下所示
代码
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim Ar As Variant
Dim lRow As Long, lCol As Long
Dim i As Long, j As Long, k As Long, l As Long
'~~> Set this to the relevant sheet
Set ws = Sheet1
With ws
If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
'~~> Find last row and column
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lCol = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
'~~> Get the data into an array
Ar = .Range(.Cells(1, 1), .Cells(lRow, lCol))
End With
'~~> Clear the rows in an array for the required condition
For i = LBound(Ar) To UBound(Ar)
For j = 1 To lCol
For k = 2 To lCol
'~~> An additional check to see if the compared cell is not blank
If Ar(i, j) = Ar(i, k) And Len(Trim(Ar(i, 1))) <> 0 And j <> k Then
For l = 1 To lCol: Ar(i, l) = "": Next l
Exit For
End If
Next k
Next j
Next i
Dim delRange As Range
With ws
'~~> Clear data for output
.Cells.Clear
'~~> Get the data back in the worksheet
.Range("A1").Resize(lRow, lCol).Value = Ar
If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
'~~> Find the new last row
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'~~> Check for blank rows
For i = 1 To lRow
If Application.WorksheetFunction.CountA(.Range(.Cells(i, 1), .Cells(i, lCol))) = 0 Then
If delRange Is Nothing Then
Set delRange = .Rows(i)
Else
Set delRange = Union(delRange, .Rows(i))
End If
End If
Next i
'~~> If blank rows found then delete them in one go
If Not delRange Is Nothing Then delRange.Delete shift:=xlUp
End With
End Sub
在行动
通过一点研究,我发现下面的 function 将删除同一单元格中的重复项。
Function RemoveDupeWords(text As String, Optional delimiter As String = " ") As String
Dim dictionary As Object
Dim x, part
Set dictionary = CreateObject("Scripting.Dictionary")
dictionary.CompareMode = vbTextCompare
For Each x In Split(text, delimiter)
part = Trim(x)
If part <> "" And Not dictionary.Exists(part) Then
dictionary.Add part, Nothing
End If
Next
If dictionary.Count > 0 Then
RemoveDupeWords = Join(dictionary.keys, delimiter)
Else
RemoveDupeWords = ""
End If
Set dictionary = Nothing
End Function
将此 function 作为公式应用在您需要解决方案的范围内。
RemoveDupeWords(text, [delimiter])
在哪里:
文本(必需)- 要从中删除重复文本的字符串或单元格。 分隔符(可选)- 分隔重复文本的分隔符。 如果省略,则使用空格作为分隔符。 function 不区分大小写,这意味着小写和大写字母被视为相同的字符。
资料来源: AbleBits
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.