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

如何使用VBA从不同工作表的不同列中选择唯一值?,vba,excel,Vba,Excel,我有一个工作簿,其中有5张工作表: 奖品 波动性 大小 价值观 生长 这五张表在列中有一个股票行情表(索引上的股票名称)和日期。每三个月后,由于重新平衡,会出现一个新的报价单,例如,奖品表有2个报价单,尺寸表有4个报价单,所以所有这些报价单都在五个不同的表中显示。我想制作一个宏,从这些列表中选择不同的唯一值,并将其粘贴到一列的另一个工作表中。这需要引用Microsoft脚本运行时。转到VB编辑器,然后选择工具、引用并从中选择它。 在那之后,把这段代码粘贴到一个进程中,看看它是否能让你完成任务。它

我有一个工作簿,其中有5张工作表:

  • 奖品
  • 波动性
  • 大小
  • 价值观
  • 生长

  • 这五张表在列中有一个股票行情表(索引上的股票名称)和日期。每三个月后,由于重新平衡,会出现一个新的报价单,例如,奖品表有2个报价单,尺寸表有4个报价单,所以所有这些报价单都在五个不同的表中显示。我想制作一个宏,从这些列表中选择不同的唯一值,并将其粘贴到一列的另一个工作表中。

    这需要引用Microsoft脚本运行时。转到VB编辑器,然后选择工具、引用并从中选择它。

    在那之后,把这段代码粘贴到一个进程中,看看它是否能让你完成任务。它肯定会把你的知识推向一个新的方向——字典和数组在正确的人手中是令人惊奇的东西,而在错误的人手中则是充满厄运的东西。你被警告过

    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
    

    通过使用阵列,它的速度非常快,对空单元的额外检查只会提高性能。

    到目前为止,您尝试了什么?您是否可以显示迄今为止您试图解决问题的任何代码?这给了我们一些参考我们了解你的目标,你的问题是什么?我在不同的表格中循环,选择所需的列,直到达到特定工作表的最后一列,并将它们粘贴到同一工作簿的不同工作表中。然后我使用宏删除重复值。如果您想进一步解释我的建议答案,请询问。只需少量编辑,它就可以提供您的解决方案。这些代码每三个月出现一次,如果我使用您的代码,那么我必须在三个月后更新代码中的范围(代码列表)。那么每次在每张表上的代码位置都会发生变化吗?六月是工作表“奖品”上的A栏和B栏,七月是E&F栏?如何识别相关列?您可以搜索标题文本并记下它出现的位置。我在不同的工作表中循环,选择所需的列,直到达到特定工作表的最后一列,并将它们粘贴到同一工作簿的不同工作表中。然后我使用宏删除重复值>[…]选择所需列[…]怎么做?你采用的标准是什么?是在位置(A列、D列等)还是在标题文本(“股票代码1”)?我问了一些你没有回答的具体问题(有两次),事实上,你只是复制/粘贴了一个答案。这取决于你,但我认为你能提供的帮助太少了。