当我使用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