Как вывести элементы коллекции в столбец на новом листе? - PullRequest
0 голосов
/ 10 апреля 2019

У меня есть следующий код, предназначенный для извлечения уникальных значений из диапазона, вывод которого выводится в окне отладки:

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

Как я могу напечатать его в столбце (значение на ячейку) на новом листе?

1 Ответ

2 голосов
/ 10 апреля 2019

Вы можете создать новый лист с именем, которое вы предпочитаете, а затем итерировать ячейки одного столбца, чтобы добавить значения к нему.Вот один из способов создания листа с помощью вспомогательной функции:

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.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...