Question

我有以下代码旨在从范围中提取唯一值，其输出显示在调试窗口中：

Option Explicit

Sub main()
    Dim uniques As Collection
    Dim source As Range

    Set source = ActiveSheet.Range("P2:AF60000")
    Set uniques = GetUniqueValues(source.Value)

    Dim it
    For Each it In uniques
        Debug.Print it
    Next
End Sub

Public Function GetUniqueValues(ByVal values As Variant) As Collection
    Dim result As Collection
    Dim cellValue As Variant
    Dim cellValueTrimmed As String

    Set result = New Collection
    Set GetUniqueValues = result

    On Error Resume Next

    For Each cellValue In values
        cellValueTrimmed = Trim(cellValue)
        If cellValueTrimmed = "" Then GoTo NextValue
        result.Add cellValueTrimmed, cellValueTrimmed
    NextValue:
    Next cellValue

    On Error GoTo 0
End Function

如何将其打印到新工作表中的列（每个单元格的值）上？

Answer 1

您可以使用自己喜欢的名称创建一个新工作表，然后迭代一列的单元格以向其中添加值。这是使用助手功能创建工作表的一种方法：

Public Function CreateSheet(ByVal shtName As String) As Worksheet
    Dim ws As Worksheet
    With ThisWorkbook
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        ws.Name = shtName
    End With
    Set CreateSheet = ws
End Function

您可以像这样使用它：

Sub main()
    Dim uniques As Collection
    Dim source As Range

    Set source = ActiveSheet.Range("P2:AF60000")
    Set uniques = GetUniqueValues(source.Value)

    Dim outputSheet As Worksheet
    Set outputSheet = CreateSheet("Output")

    Dim i As Long
    For i = 1 To uniques.Count
        'Debug.Print uniques(i)
        outputSheet.Cells(i, 1).Value = uniques(i)
    Next
End Sub

这将创建一个名为Output的新工作表，并使用您的A集合中的值填充该工作表的列uniques。

如何将收集项目输出到新工作表中的列？

1 个答案: