从命名范围中提取唯一值

Question

我已在单元格Working的{​​{1}}标签中创建了工作表的命名范围列表，我想从中将单元格AD3:AD25中的唯一值拉到列的最后一个范围{ {1}} 来自每个命名范围工作表，同样我创建名称管理器为A2，并使用命名范围我想提取唯一值。

_{预期结果如下所示。点击图片查看Google云端硬盘上的示例工作簿：}

Answer 1

使用下列内容：

Option Explicit

Sub test()

    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Working")

    Dim currCell As Range
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    For Each currCell In ws.Range("MySheets")

        Dim currSht As Worksheet

        On Error Resume Next

        Set currSht = wb.Worksheets(currCell.Value)

        With currSht

            Dim loopRange As Range
            Set loopRange = .Range("A2:A" & GetLastRow(currSht))

            Dim loopValue As Range

            For Each loopValue In loopRange

                If Not dict.exists(loopValue.Value) Then
                    dict.Add loopValue.Value, loopValue.Value
                End If

            Next loopValue

        End With

        On Error GoTo 0

    Next currCell

    ws.Range("AE2").Resize(dict.Count, 1) = Application.WorksheetFunction.Transpose(dict.keys)

End Sub
Public Function GetLastRow(ByVal sht As Worksheet) As Long

With sht

    GetLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

End With

End Function