Динамический список на основе функции COUNTIF

Question

List I        List II
A             G
B             X
I             R
G             L
H             U
K             A
L             S
N
R

В следующем списке я использовал функцию CountIF для подсчета элементов, найденных в списке II, но не в списке I. Впоследствии я создал столбец с именем CountIF, который затем заполняется 1 или 0. Затем я открыл новый лист и использовал следующую формулу IF (CountIF_Column = 1; ""; запись из списка II).

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

Мои идеи: Могу ли я вставить динамическое имя для списка с пробелами, а затем как-нибудь очистить пустые пробелы? Не знаю, как это сделать ... Любая помощь приветствуется.

Answer 1

Вы можете использовать массивы и словарь (сохранит только уникальные значения). Далее предполагается, что list1 находится в столбце A, а list2 находится в столбце B и записывает значения из list2, а не в list1, в столбец C. Также предполагается, что в строке 1 есть заголовки.

Option Explicit
Public Sub test()
    Dim arr1(), arr2(), outputList As Object
    Dim lastRow1 As Long, lastRow2 As Long, i As Long
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row

        If lastRow1 = 2 Then
            ReDim arr1(1, 1): arr1 = .Range("A2").Value
        Else
            arr1 = .Range("A2:A" & lastRow1).Value
        End If
        If lastRow2 = 2 Then
            ReDim arr2(1, 1): arr1 = .Range("B2").Value
        Else
            arr2 = .Range("B2:B" & lastRow2).Value
        End If

        arr1 = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr1, 0, 1))
        Set outputList = CreateObject("Scripting.Dictionary")

        For i = LBound(arr2, 1) To UBound(arr2, 1)
            If Not IsEmpty(arr2(i, 1)) Then
                If IsError(Application.Match(arr2(i, 1), arr1, 0)) Then
                    outputList(arr2(i, 1)) = 1
                End If
            End If
        Next
        If outputList.Count > 0 Then
            .Range("C2").Resize(outputList.Count, 1) = Application.WorksheetFunction.Transpose(outputList.keys)
        End If
    End With
End Sub