我有一张工作簿,其中有5张:
这五张纸的列表中有一个股票代码列表(股票名称)以及日期。每三个月后,一个新的股票清单会因为重新平衡而产生。 PRIZE表有2个重新平衡,所以2个自动收录器列表和SIZE表有4个重新平衡所以4个自动收录器列表,因此所有这些自动收录器列表都显示在五个不同的表中。我想创建一个宏,从这些列表中选择不同的唯一值,并将其粘贴到一列中的另一个表中。
答案 0 :(得分:0)
这需要引用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
通过使用数组,它是闪电般快速的,额外检查空单元格只能提高性能。