Перенос дубликатов в столбце на другую страницу с использованием коллекции

Question

Я пытаюсь переместить элементы в столбце на другую страницу, если они дублируются по определенным критериям.

Мой код останавливается на моем втором операторе 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

Answer 1

Может попробовать

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