Excel: Извлечь уникальный отдельный список элементов в алфавитном порядке из двух столбцов

Question

Я пытаюсь выяснить, как выполнить следующие задачи, используя VBA или формулу Excel: Начиная с двух столбцов, содержащих некоторые значения, я хотел бы извлечь в третьем столбце каждый элемент с количеством символов ниже или равным3. Столбец 3 должен содержать все значения длиной <= 3 в алфавитном порядке. </p>

Например, если у нас есть:

Car     Body
Sun     Sun
Bee     Share
Bath    Spot

Столбец 3 должен содержать

Bee 
Car 
Sun

У кого-нибудь есть идея, как я могу это сделать?Я попробовал опцию расширенной фильтрации, но мне не удалось указать в качестве входных данных два разных столбца при указании длины слова.

Answer 1

Попробуйте это:

Sub foo()
    Dim c As Range
    Dim cIn As Range
    Dim cOut As Range
    Dim iLen As Integer

    Set cIn = ActiveSheet.Range("A1:B4")
    Set cOut = ActiveSheet.Range("D1")
    iLen = 3

    With CreateObject("scripting.dictionary")
        For Each c In cIn
            If Len(c.Value) <= iLen Then .Item(c.Value) = c.Value
        Next c
        cOut.Resize(.Count) = Application.Transpose(.Keys)
        cOut.Resize(.Count).Sort Key1:=cOut, Order1:=xlAscending, Header:=xlNo
    End With
End Sub

Answer 2

Это общая формула, поэтому другим людям легче ее модифицировать.

Вы можете легко удалить дубликаты, используя .RemoveDuplicates, и упорядочить по алфавиту, используя .Sort встроенные методы в вашем собственном примере.

Private Sub test()

    Dim rng As Range: Set rng = ActiveSheet.Range("A1:B4")
    Dim offsetindex As Integer
    offsetindex = 0

    For Each field In rng

        If (Len(field) <= 3) Then
            ActiveSheet.Range("C1").Offset(offsetindex, 0) = field
            offsetindex = offsetindex + 1
        End If

    Next field

End Sub

Очевидно, что ваш (табличный) диапазон начинается с A1

Answer 3

Как насчет:

Sub MAIN()
    Dim it As Range, r As Range, x0
        With CreateObject("scripting.dictionary")
            For Each it In Range("A1:B4")
                If Len(it.Value) <= 3 Then
                    x0 = .Item(it.Value)
                End If
            Next it

            Set r = Range("C1").Resize(.Count, 1)
            r.Value = Application.Transpose(.Keys)
            r.Sort [C1], 1
        End With
End Sub

Этот словарь может извлекать уникальные слова: