使用集合将列中的重复项传输到另一页

  • 本文关键字:传输 一页 集合 vba
  • 更新时间 :
  • 英文 :


如果具有特定条件的重复项,我正在尝试将列中的项目移动到另一页上。

我的代码在我的第二个 if 语句处停止,我不知道如何使用我的新行值搜索集合。我觉得我几乎得到了它,但不知道如何解决它。

Sub duplicates ()
Dim tasks as collection
Set tasks = new collection
Dim row, m as long 
Dim task as variant 
Row = 9
M= 3

 Do until trim(sheets(“itemreport”).range(“k” & row).value) =“”
 If trim(sheets(“itemreport”).range(“f” & row).value) = “credited”     then
  If trim(sheets(“itemreport”).range(“k” & row).value = tasks(item)      then ‘Part I am having trouble on
       Sheets(“credited”).range(“r” & m) =  trim(sheets(“itemreport”).range(“k” & row).value)
       M = m +1
       Else: tasks.add (trim(sheets(“itemreport”).range(“k” & row).value)
End if
End if
Row = row + 1
Loop

可以尝试

Sub duplicates()
Dim Tasks As Collection
Set Tasks = New Collection
Dim Rw, m As Long, i As Long
Dim Task As Variant
Dim WsSrc As Worksheet, WsTrg As Worksheet
Dim DupFound As Boolean
Set WsSrc = ThisWorkbook.Sheets("itemreport")
Set WsTrg = ThisWorkbook.Sheets("credited")
Rw = 9
m = 3
With WsSrc
Do Until Trim(.Range("k" & Rw).Value) = ""
    If Trim(.Range("f" & Rw).Value) = "credited" Then
        DupFound = False
            For i = 1 To Tasks.Count
                If Trim(.Range("k" & Rw).Value) = Tasks(i) Then  'Part I am having trouble on
                WsTrg.Range("r" & m) = Trim(.Range("k" & Rw).Value)
                m = m + 1
                DupFound = True
                Exit For 
                End If
            Next i
            If DupFound = False Then
            Tasks.Add Trim(.Range("k" & Rw).Value)
            End If
     End If
Rw = Rw + 1
Loop
End With
End Sub

最新更新