[英]Delete entire row if the same value is found in another cell on the same row
首先，我必須提到我正在使用Excel for Mac ，因此任何代碼建議都需要適用於使用 Office 365 的 Mac 。
我有一個包含九列名稱的大型數據集。 如果同一行的多個列中有相同的名稱，我想刪除整行
示例數據集：
所以所有這些行都將被刪除，因為：
Jason在第1行出現twiceJason在第2行出現3次Jason在第3行出現4次Sam在第4行出現twiceFred在第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
如果工作表上的單元格值與另一張表上的單元格值相同，則刪除該行
[英]Delete the row if the cell value on sheet is the same then the cell value on another sheet
如果前一行中的相同單元格相同，如何在Excel中刪除整行？
[英]How to delete an entire row in Excel if same cell in preceding row is identical?
如果在另一列上找到一個單元格的值，如何從與同步單元格在同一行的另一列返回該單元格的值？
[英]If a cell's value is found on another column, how to return the cell's value from another column which is on same row with the synced cell?
用於根據同一行中的另一個單元格值過濾行中的單元格的 VBA
[英]VBA for filtering cells in a row based on another cell value in the same row
從與另一行中的單元格相對應的行中獲取值（在同一列中）
[英]Get value from a row that corresponds (in the same column) to a cell in another row
如果我刪除同一行中另一個單元格的值，是否有刪除單元格值的函數？
[英]Is there a function that deletes a cells value if I delete the value of another cell in the same row?
聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.