Question

我是VBA中的新手，我需要做的是将指定列中的行复制到另一个工作表的列中，但我想复制每个单词的一个出现，例如

Column "F"
dog
dog
cat
dog

在结果中，我需要使用名为“Animals”的新工作表：

Column "A"    Column "B"
1             dog
2             cat

Answer 1

您是否需要在VBA中执行此操作？

如果您只想获取列表的唯一副本，请选择未排序的非唯一列内容（包括标题），然后单击“数据”功能区的“排序和过滤”窗格上的“高级...”按钮。您可以要求它复制到另一个位置并仅勾选唯一记录。

记录此活动并查看VBA，它的外观如下：

Range("A1:A4").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True

Answer 2

这是一个完全符合您要求的子程序：将Sheet1列F中的唯一元素列表打到sheet2的A列，并重命名表单“animals”。你可以调整这个，这样你就不用改变了sheet2的名字就可以创建一个新的工作表。

Sub UniqueList()

Application.ScreenUpdating = False
Dim lastRow As Long
Dim i As Long
Dim dictionary As Object
Set dictionary = CreateObject("scripting.dictionary")

Sheet1.Activate
lastRow = Sheet1.Cells(Rows.count, "F").End(xlUp).row

On Error Resume Next
For i = 1 To lastRow
    If Len(cells(i, "F")) <> 0 Then
        dictionary.Add cells(i, "F").Value, 1
    End If
Next

Sheet2.range("a1").Resize(dictionary.count).Value = _
Application.Transpose(dictionary.keys)

Application.ScreenUpdating = True
MsgBox dictionary.count & " unique cell(s) were found and copied."

End Sub

工作原理：我使用字典文件，它会自动删除所有条目，然后将条目列表打到sheet2。

Answer 3

这是一个解决方案：

Option Explicit
Sub copyNoDuplicates()
Dim rLastCell As Range
Dim cell As Range, i As Long
Dim cAnimals As Collection
Set cAnimals = New Collection
With ActiveWorkbook.Worksheets("Sheet1")
    'Find last used cell
    Set rLastCell = .Range("F65536").End(xlUp)
    'Parse every animal and put it in a collection
    On Error Resume Next
    For Each cell In .Range("F2:F" & rLastCell.Row)
        cAnimals.Add cell.Value, CStr(cell.Value)
    Next cell
    On Error GoTo 0
End With
With ActiveWorkbook.Worksheets("Sheet2")
    For i = 1 To cAnimals.Count
        .Range("A" & i).Value = i
        .Range("B" & i).Value = cAnimals(i)
    Next i
End With
End Sub

从指定列复制单元格，删除重复项

3 个答案: