當我使用VBA刪除其他工作表中包含重複值的角色時，如何刪除不包含重複項的角色

Question

我想刪除列B中已有ID出現在「交易」片。但是，當我使用下面的代碼刪除行時，不重複的ID行也被刪除（最頂層的異常除外）。我的刪除代碼是否有誤？

這裏是我的代碼：

Sub Removeduplicate() 
Dim i As Integer 
Dim j As Integer 
Dim num As Integer 
Dim lastCellB As Range 
    num = 0 
    For i = 2 To 10000 
     If ActiveWorkbook.Sheets("Manual").Cells(i, 2).Value > 0 Then 
      num = num + 1 
     End If 
    Next i 
    ActiveWorkbook.Sheets("Manual").Range("B5000").Select 
    j = ActiveWorkbook.Sheets("Manual").Cells(Rows.Count, "B").End(xlUp).Row 
    Do While num > 0 
     lastvalue = ActiveWorkbook.Sheets("Manual").Cells(j, 2).Value 
     For i = 2 To 10000 
     If ActiveWorkbook.Sheets("Trade").Cells(i, 4).Value = lastvalue Then 
      ActiveWorkbook.Sheets("Manual").Cells(j, 2).EntireRow.Delete 
     End If 
     Next i 
     j = j - 1 
     num = num - 1 
    Loop 
MsgBox ("Removed") 


End Sub 

這裏是我的數據的屏幕截圖 「交易」 片

和 「手動」 片

。

Answer 1

Sub Removeduplicate() 

With activeworkbook 

Dim TradeSheet as worksheet 
Set TradeSheet = activeworkbook.worksheets("Trade") 

Dim IDsOnTradeSheet as variant 
IDsOnTradeSheet = application.transpose(tradesheet.range("D2:D10000").value2) 

Dim IDsOnManualSheet as variant 
IDsOnManualSheet = application.transpose(.worksheets("Manual").range("B2:B10000").value2) 

End with 

' Loop through each Manual Sheet ID and keep trying to find each one in Trade Sheet IDs.' 

Dim ReadIndex as long 
Const TRADEIDCOLUMN as string = "B" 
Dim Counter as long 

Dim MatchResult as variant 'This variable will contain either number or error.' 

Dim RowsToDelete() as string 
Redim RowsToDelete(1 to 10000) 

For readindex = lbound(idsonmanualsheet) to ubound(Idsonmanualsheet) 

Do 
Matchresult = application.match(idsonmanualsheet(readindex),idsontradesheet,0) 
If isnumeric(matchresult) then 
Counter = counter + 1 
RowsToDelete(Counter) = tradeidcolumn & (matchresult+1) '+1= offset, as first row = 2 and lbound should = 1)' 
End if 
Doevents 
Loop until iserror(matchresult) 

Next readindex 

Redim preserve RowsToDelete(lbound(RowsToDelete) to counter) 

With Application 
.screenupdating = false 
.calculation = xlcalculationmanual 

Tradesheet.range(strings.join(RowsToDelete,",").entirerow.delete 

.screenupdating = true 
.calculation = xlcalculationautomatic 
End With 

MsgBox ("Removed") 
End Sub 

1. 是否行得通？
2. 它做你想做的？

寫在移動設備上，抱歉格式不對/縮進。

Answer 2

這裏是我的意見希望你會發現它有用：

1. 在刪除行使用For...Next循環，Step -1應使用

   'Example 
   For i = 10000 to 2 Step -1 
       ... 
   Next` 
   

   爲什麼？那麼讓我們說i現在在i = 3，這整行被刪除。刪除後，第4行現在成爲第3行。因此，在Next上，i將迭代到i = 4，但現在它將檢查第5行，因爲您的整個表已從第4行開始向上移位，因爲第3行已被刪除。

2. 儘可能使用內建的Worksheetfunction而不是自定義製作它們，因爲它比自定義函數（或過程）執行速度快得多。

   'You can replace this: 
   num = 0 
   For i = 2 To 10000 
       If ActiveWorkbook.Sheets("Manual").Cells(i, 2).Value > 0 Then 
        num = num + 1 
       End If 
   Next i 
   
   'with this 
   num = Application.WorksheetFunction.CountA(Sheets("Manual").Range("B:B")) - 1 
   

3. 無需.Select任何與.End(xlUp)使用。 Select僅用於視覺。

   'This line can be deleted. 
   ActiveWorkbook.Sheets("Manual").Range("B5000").Select 
   

4. 同樣，使用Worksheetfunction，尋找是否ISIN在「手冊」中存在「交易」表，你可以這樣做

   If Application.Worksheetfunction.CountIf(Sheets("Trade").Range("D:D"), _ 
       Sheets("Manual").Cells(i, "B")) > 0 Then 
   
       Sheets("Manual").Cells(i, "B").EntireRow.Delete 
   End If 
   

5. 東西，如果你正在運行在此宏只有一個工作簿，即ActiveWorkbook，那麼你可以省略你對ActiveWorkbook的引用。但是，由於您在兩張表中運行此宏，即「手動」和「交易」，因此您應該對所有對相應工作表的引用進行限定。

總之，我看到的是你只需要做一次For...Next循環來刪除不需要的行。沒有必要使用Do While...Loop循環。

R

Answer 3

使用聯合方法很簡單，快捷。

Sub Removeduplicate() 
    Dim rngU As Range, rng As Range 
    Dim rngA As Range, rngB As Range 
    Dim Ws As Worksheet, bWs As Worksheet 
    Dim Wf As WorksheetFunction 

    Set Wf = WorksheetFunction 

    Set Ws = Sheets("Manual") 
    Set bWs = Sheets("Trade") 

    With bWs 
     Set rngB = .Range("d2", .Range("d" & Rows.Count).End(xlUp)) 
    End With 
    With Ws 
     Set rngA = .Range("b2", .Range("b" & Rows.Count).End(xlUp)) 
    End With 

    For Each rng In rngA 
     If Wf.CountIf(rngB, rng) Then 
      If rngU Is Nothing Then 
       Set rngU = rng 
      Else 
       Set rngU = Union(rngU, rng) 
      End If 
     End If 
    Next rng 
    If Not rngU Is Nothing Then 
     rngU.EntireRow.Delete 
     MsgBox "Removed" 
    End If 
End Sub