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

使用集合将列中的重复项转移到另一个页面

1 个答案: