如何使用VBA从不同工作表中的不同列中选择唯一值？

Question

我有一张工作簿，其中有5张：

1. 奖
2. 挥发性
3. 尺寸
4. 值
5. 生长

这五张纸的列表中有一个股票代码列表（股票名称）以及日期。每三个月后，一个新的股票清单会因为重新平衡而产生。 PRIZE表有2个重新平衡，所以2个自动收录器列表和SIZE表有4个重新平衡所以4个自动收录器列表，因此所有这些自动收录器列表都显示在五个不同的表中。我想创建一个宏，从这些列表中选择不同的唯一值，并将其粘贴到一列中的另一个表中。

Answer 1

这需要引用Microsoft Scripting Runtime。转到VB编辑器，然后转到工具，参考，然后从那里选择它。

之后，将此代码粘贴到一个proc中，看看它是否让你超越了这一行。它肯定会把你的知识推向一个新的方向 - 字典和数组在正确的手中是令人惊奇的东西，在完全错误的手中完全是毁灭性的。你已被警告过了！！

Dim dctUniqueTickers        As Dictionary
Dim dctTickerLocations      As Dictionary
Dim arrCurrentTickerRange   As Variant
Dim arrTickerOutput         As Variant
Dim varSheetNames           As Variant
Dim lngDctCounter           As Long
Dim lngRowCounter           As Long
Dim lngColCounter           As Long
Dim lngAreaCounter          As Long

' Set up the ticker location range(s)
Set dctTickerLocations = New Dictionary
With dctTickerLocations
    .Add "prize", Application.Union(ThisWorkbook.Worksheets("prize").Range("A:A"), _
                                    ThisWorkbook.Worksheets("prize").Range("C:C"))
    .Add "size", Application.Union(ThisWorkbook.Worksheets("size").Range("A:A"), _
                                    ThisWorkbook.Worksheets("size").Range("E:E"), _
                                    ThisWorkbook.Worksheets("size").Range("F:F"), _
                                    ThisWorkbook.Worksheets("size").Range("H:H"))
End With

' Populate the destination dictionary
Set dctUniqueTickers = New Dictionary
For Each varSheetNames In dctTickerLocations.Keys
    ' Looping through the keys (the worksheet names), pick up the associated range(s)
    '  - there may be multiple areas to consider
    For lngAreaCounter = 1 To dctTickerLocations(varSheetNames).Areas.Count
        arrCurrentTickerRange = dctTickerLocations(varSheetNames).Areas(lngAreaCounter)

        For lngRowCounter = LBound(arrCurrentTickerRange, 1) To UBound(arrCurrentTickerRange, 1)
            For lngColCounter = LBound(arrCurrentTickerRange, 2) To UBound(arrCurrentTickerRange, 2)
                If LenB(arrCurrentTickerRange(lngRowCounter, lngColCounter)) > 0 Then
                    If Not dctUniqueTickers.Exists(arrCurrentTickerRange(lngRowCounter, lngColCounter)) Then
                        ' Ticker not found within the dictionary, so add it
                        dctUniqueTickers.Add arrCurrentTickerRange(lngRowCounter, lngColCounter), arrCurrentTickerRange(lngRowCounter, lngColCounter)
                    End If
                End If
            Next
        Next
    Next
Next

If dctUniqueTickers.Count > 0 Then
    lngDctCounter = 0

    ' Now output
    ThisWorkbook.Worksheets("OutputSheet").Range("A1").Value = "Unique tickers"
    For Each arrTickerOutput In dctUniqueTickers.Keys
        ThisWorkbook.Worksheets("OutputSheet").Range("A2").Offset(lngDctCounter, 0).Value = CStr(arrTickerOutput)

        lngDctCounter = lngDctCounter + 1
    Next
End If

通过使用数组，它是闪电般快速的，额外检查空单元格只能提高性能。